home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mplbas.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1989-09-26  |  118KB  |  3,394 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 05-28-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  ALLCAPS    58060   Convert a string to all upper case characters
  19. '  AMORPM     41498   Calculate the current time as AM or PM
  20. '  ASKGRAPH   43004   Determine users graphic default
  21. '  BADFILE    20741   Check for system crash attempt with bad device name
  22. '  CARRIER    42000   Test for whether to continue in RBBS           ' KG080501
  23. '  CHECKRATIO 20096   Test upload/download ratio
  24. '  CHECKTIM   58070   Test to insure that users don't exceed their time
  25. '  CHKCARRIER 42005   Checks whether still have carrier              ' KG080501
  26. '  CHKNEWBUL  58110   Check for new bulletins based on their file creation date
  27. '  CHKTREMAIN 41008   Set up to log off if time exceeded
  28. '  COMMINFO   44020   Get users baud rate and parity in a string format
  29. '  CTLINES    58160   Count categories a file can be classified into
  30. '  CTNEWFILES 58150   Check for number of files uploaded after a specific date
  31. '  DELAYIT    50495   Wait number of seconds specified before returning
  32. '  DISPCALL   57001   Display callers file
  33. '  DISPLAYTR  41032   Compute and display time remaining
  34. '  DISUPDIR   58165   Display the shared directory of the FMS mng. sys.
  35. '  FILELOCK   21993   Allow files to be shared among multiple RBBS-PC's
  36. '  FINDFUNC   30595   Handle local keyboard's function & SYSOP's keys
  37. '  FINDLAST   58600   Finds last occurence of a string in a string
  38. '  FINDTIME   58050   Calculate the number of seconds since midnight
  39. '  GRAPHIC    43031   Determines whether graphic version of file exists
  40. '  HASHRBBS   58080   "Hash" to a user's record in the USERS file
  41. '  INITFMS    58162   Initialize the RBBS-PC's File Management System
  42. '  INITIBM    30000   Open/create NETBIOS semaphore file
  43. '  INSCOMMA   58130   Format commands in the command prompt
  44. '  LIBRARY    21105   Provide support for "library" drives
  45. '  LINESNFIL  58161   Counts lines in a file
  46. '  LOADNEW    58140   Find the latest uploads
  47. '  MODEMPUT   52070   Write a modem command string to the modem
  48. '  OPENMSG    30500   Open the messages file as file number 1
  49. '  PAGEUP     33202   Display user info. on local screen for SYSOP
  50. '  READPROF   44000   Read user's profile on return from a "door"
  51. '  SAVEPROF   43068   Save the user's provile when exiting to "doors" or DOS
  52. '  SENDNAME   20293   Send filename via EXEC-PC protocol during autodownload
  53. '  SETOPTS    58100   Set correct prompt line for each subsystem
  54. '  SRTSTRNG   58120   Sort characters in a string
  55. '  TESTUSER   20310   Check if user's software can do auto downloading
  56. '  TIMEREMAIN 41010   Compute time remaining in minutes
  57. '  UPDTUPLOAD 20705   Updates upload directory file
  58. '  WILDFILE   20290   Determines whether string matches a pattern
  59. '  XFERTYPE   21600   Identify the file transfer protocol
  60. '
  61. '  $INCLUDE: 'RBBS-VAR.BAS'
  62. '
  63. 20290 ' $SUBTITLE: 'WILDFILE -- Matches file to a filespec'
  64. ' $PAGE
  65. '  NAME    -- WILDFILE
  66. '
  67. '  INPUTS  -- PARAMETER             MEANING
  68. '             PATTERN$           PATTERN TO CHECK AGAINST
  69. '             ITEM.TO.MATCH$     FILE NAME TO MATCH
  70. '
  71. '  OUTPUTS -- DOES.MATCH         WHETHER MATCHES
  72. '
  73. '  PURPOSE  Determine whether a file name is an instance of
  74. '    a file specification.  Exactly like DOS except that ? must have a
  75. '    character.
  76. '
  77.       SUB WILDFILE (PATTERN$,ITEM.TO.MATCH$,DOES.MATCH) STATIC
  78.       IF PATTERN$ <> PREV.PATTERN$ THEN _
  79.          CALL BRKFNAME (PATTERN$,PDR$,PPREFIX$,PEXT$,FALSE) : _
  80.          PREV.PATTERN$ = PATTERN$
  81.       CALL BRKFNAME (ITEM.TO.MATCH$,IDR$,IPREFIX$,IEXT$,FALSE)
  82.       DOES.MATCH = FALSE
  83.       IF PDR$ <> "" AND PDR$ <> IDR$ THEN _
  84.          EXIT SUB
  85.       CALL WILDCARD (PPREFIX$,IPREFIX$)
  86.       IF NOT OK THEN _
  87.          EXIT SUB
  88.       CALL WILDCARD (PEXT$,IEXT$)
  89.       DOES.MATCH = OK
  90.       END SUB
  91. 20293 ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  92. ' $PAGE
  93. '
  94. '  NAME    -- SENDNAME
  95. '
  96. '  INPUTS  --  PARAMETER                    MEANING
  97. '              B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  98. '              DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  99. '
  100. '  OUTPUTS --  ABORT               -1 FOR AN ABORTED ATTEMPT
  101. '
  102. '  PURPOSE -- Send the download filename to user during an autodownload
  103. '
  104.       SUB SENDNAME STATIC
  105. '
  106. '
  107. ' *  TRANSFER FILENAME TO USER
  108. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  109. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  110. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  111. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  112. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  113. ' *                   COMPLETION AND FILE TRANSFER BEGINS.
  114. '
  115. '
  116.       ABORT = FALSE                      ' RESET ABORT FLAG
  117.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  118. 20295
  119. 20296
  120. 20298
  121. 20300
  122. 20305
  123. 20306
  124. 20310
  125. 20313     
  126. 20315 END SUB
  127. '
  128. '
  129. ' ********* Maple UPDTU... ******
  130. '
  131. '
  132. 20705 ' $SUBTITLE: 'UPDTUPLOAD -- Updates upload directory'
  133. ' $PAGE
  134. '  SUBROUTINE NAME    -- UPDTUPLOAD
  135. '
  136. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  137. '                        FILE.NAME$
  138. '                        UPLOAD.DIRECTORY$
  139. '                        FILE.NAME.HOLD$
  140. '                        SHARE.IT
  141. '                        FMS.DIRECTORY$
  142. '                        Q!
  143. '                        TCA!
  144. '
  145. '  OUTPUT PARAMETERS  -- BYTES.IN.FILE#
  146. '                        SECONDS.PER.SESSION!
  147. '
  148. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  149. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  150. '
  151.       SUB UPDTUPLOAD (CATEGORY.NAME$(1),CATEGORY.CODE$(1),LINES.IN.DESC,FF) STATIC '<===
  152.       ON FF GOTO 20710,20724,20723,20722
  153. 20710 ABORT = FALSE    ' PE ABORT MOD
  154.        CALL QTPUT1 ("Describe " + FILE.NAME.HOLD$ +CRLF$ + _
  155.            " (Begin with  /  if for SYSOP only) or enter ABORT to cancel")
  156.       CALL QTPUT1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  157.                  MAX.DESC.LEN - 4) + "..Max>")
  158.       CALL QTPUT ("? ",0)
  159.       A$ = ""
  160.       SUBROUTINE.PARAMETER = 1
  161.       PARSE.OFF = TRUE
  162.       CALL TGET
  163.       CALL CARRIER
  164.       IF SUBROUTINE.PARAMETER = -1 THEN _
  165.          B$ = "<description unavailable>": _
  166.          GOTO 20712
  167.       IF B$ = "ABORT" OR B$ = "abort" THEN _
  168.       ABORT = TRUE : _
  169.       EXIT SUB
  170.       IF LEN(B$) > MAX.DESC.LEN OR LEN(B$) < 5 THEN _
  171. CALL QTPUT (" Description must be 5 chars min," + STR$(MAX.DESC.LEN) + " chars max",1) : _ 
  172. CALL QTPUT (" ENTER the word ABORT to cancel transfer....",1) : _
  173.          GOTO 20710
  174. 20712 DESC$ = B$
  175.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  176.          IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _
  177.             IF LEFT$(B$,1) = "/" THEN _
  178.              GOTO 20722_
  179.             ELSE GOTO 20717
  180. '
  181. 20715  IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  182.          B$ = MID$(B$(1),2) : _
  183.          UCAT$ = "***" : _
  184.          GOTO 20722
  185.       UCAT$ = DEFAULT.CATEGORY.CODE$
  186. 20717 IF SUBROUTINE.PARAMETER = -1 OR _
  187.       USER.SECURITY.LEVEL < SL.CATEGORIZE.UPLOADS THEN _
  188.       GOTO 20722
  189. 20719 CALL BUFFILE (UPCAT.HELP$,X)
  190. 20720 A$ = "Upload best fits what category (H=help)"
  191.       SUBROUTINE.PARAMETER = 1
  192.       CALL TGET
  193.       IF SUBROUTINE.PARAMETER = -1 THEN _
  194.          B$ = DEFAULT.CATEGORY.CODE$ : _
  195.          GOTO 20722
  196.       IF Q = 0 THEN _
  197.          GOTO 20719
  198.       CALL ALLCAPS (B$(1))
  199.       IF B$(1) = "H" OR _
  200.          B$(1) = "*" OR _
  201.          B$(1) = "?" THEN _
  202.          GOTO 20719
  203.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  204.       IF FOUND > 0 THEN _
  205.          UCAT$ = CATEGORY.CODE$(FOUND) : _
  206.          IF LEN(UCAT$) > 0 AND LEN(UCAT$) < 4 AND INSTR(UCAT$,",") = 0 THEN _
  207.             GOTO 20722
  208.       UCAT$ = ""
  209.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  210.          STREW.TO$ = DIRECTORY.PATH$ + _
  211.                      B$(1) + _
  212.                      "." + _
  213.                      DIRECTORY.EXTENTION$ : _
  214.          CALL FINDIT (STREW.TO$) : _
  215.          IF NOT OK THEN _
  216.             STREW.TO$ = "" _
  217.          ELSE GOTO 20722
  218.       CALL QTPUT ("No such category " + B$(1),1)
  219.       GOTO 20719
  220. 20722  IF USER.SECURITY.LEVEL >= ASK.EXTENDED.DESC AND _
  221.          MAX.EXTENDED.LINES > 0 AND SUBROUTINE.PARAMETER <> -1 THEN _
  222.          A$ = "Add an EXTENDED DESCRIPTION of " + _
  223.               FILE.NAME.HOLD$ + " (Y,[N])" : _
  224.          TURBO.KEY = -TURBO.KEY.USER : _
  225.          SUBROUTINE.PARAMETER = 1 : _
  226.          CALL TGET : _
  227.      IF SUBROUTINE.PARAMETER <> -1 THEN _
  228.         IF  YES THEN _
  229.        CALL SKIPLINE (2):_
  230.       CALL QTPUT (CHR$(7)+ " Description will be Entered AFTER the UPLOAD is Completed",2) : _
  231.     CALL DELAYIT (2) :_
  232.    GET.EXT.DESC = TRUE: _
  233.   EXIT SUB
  234.        EXIT SUB
  235. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  236. 20723  IF NOT LIMIT.SEARCH.TO.FMS THEN _
  237.          STREW.TO$ = DIRECTORY.PATH$ + _
  238.                      B$(1) + _
  239.                      "." + _
  240.                      DIRECTORY.EXTENTION$
  241.        CALL FINDIT (STREW.TO$)
  242.          IF NOT OK THEN _
  243.             STREW.TO$ = ""
  244.       B$ = DESC$
  245.       X$ = DATE$
  246.       Z$ = LEFT$(X$,6) + _
  247.            RIGHT$(X$,2)
  248.       EN$ = STREW.TO$
  249.       GOSUB 20730
  250.       EN$ = ALWAYS.STREW.TO$
  251.       GOSUB 20730
  252.       GOTO 20728              'CHANGE from 20725 to 20728  'Pe 09/12/89
  253. '
  254. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  255. '
  256.  20724 GOSUB 20734
  257.  
  258. '
  259.       CALL TIMEREMAIN (TIME.REMAINING!)
  260.       IF PRIVATE.DOOR THEN _
  261.          X! = UPLOAD.TIME.FACTOR! * Q! _
  262.       ELSE X! = UPLOAD.TIME.FACTOR! * (TCA! - Q!)
  263. '
  264. '************************8 New Convert code begins here 8*******************
  265. ' Orig mods by Warren Muldrow
  266. '
  267. ' additional mods by Pete Eibl moved code to callable Subroutines 09/25/89
  268. '
  269. '      Zip Convert code.  Does the following:
  270. '
  271. '         .EXE files are retained as is (for self-extracting files)
  272. '          files with NO extension are left alone 
  273. '
  274. '    Added a .SFX for BBS that use the EXTCHECK.DEF file to block EXE files
  275. '    this allows a user to upload self extracting EXE files only if they
  276. '    Re Name the file .SFX ( this is a personall preference and can be removed)
  277. '
  278. '         .ZIP, .ARC, .PAK, .ZOO, and .LZH are unzrc'ed and then Zipped
  279. '
  280. '         All other files are Zipped
  281. '
  282. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  283. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  284. '         ZOO.BAT and is included in this archive.
  285. '
  286. '      The Library work path (Config parm # 304) is used for a work area !!!
  287. '
  288.   IF ABORT = TRUE THEN _     'Corrects aborted uploads
  289.     EXIT SUB                'corrects aborted uploads
  290.       CALL BRKFNAME (FILE.NAME$, DR$, ZZ$, X$, TRUE)
  291.      IF X$ = ".EXE" OR X$ = "" OR EXT$ = ".SFX" THEN _
  292.    GOTO 20727
  293. '
  294. IF SYSOP OR USER.SECURITY.LEVEL > = ADD.DIR.SECURITY THEN 
  295.   A$ = " Convert or verify " + FILE.NAME$ + " ([Y],N) "
  296.       SUBROUTINE.PARAMETER = 1
  297.       CALL TGET 
  298.        IF SUBROUTINE.PARAMETER = -1 THEN _
  299.         EXIT SUB
  300.          IF NO THEN _
  301.         GOTO 20727
  302.      END IF
  303. IF LOCAL.USER THEN _
  304.   CALL LOCALCONVERT (DR$,ZZ$,X$) _
  305.  ELSE _
  306.   CALL CONVERT2ZIP (DR$,ZZ$,X$)
  307. '
  308. 20727 GOSUB 20734     'Pe 09/06/89
  309.        CALL QTPUT(CX$(5)+"Upload successful,Thanks for the file "+CX$(2) + FIRST.NAME$+CX$(7),1)
  310.   OK = 0
  311.    CALL CHECKNOVELL (OK)
  312.     IF OK <> -1 THEN _
  313.       CALL SETSHAREDATTR (FILE.NAME$, OK) : _
  314.        IF OK <> 0 THEN _
  315.         CALL PSCRN ("Error setting shared attribute")
  316.       IF GET.EXT.DESC THEN _
  317.         EXIT SUB     
  318.        X$ = DATE$
  319.        Z$ = LEFT$(X$,6) + RIGHT$(X$,2)
  320.        STREW.TO$ = ""
  321.        B$ = DESC$
  322.        EN$ = ALWAYS.STREW.TO$
  323.        GOSUB 20730
  324.        EN$ = STREW.TO$
  325.        GOSUB 20730 
  326. '
  327. 20728  IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _ 
  328.         IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  329.          CALL UPDTCALR (B$,2): _
  330.        GOTO 20729
  331. '******************
  332.   EN$ = UPLOAD.DIRECTORY$
  333.        GOSUB 20730
  334. 20729 DF$ = " >> uploaded << "
  335.       UPLOADS = UPLOADS + 1
  336.       GLOBAL.UPLOADS = GLOBAL.UPLOADS + 1
  337.       ULBYTES! = ULBYTES! + BYTES.IN.FILE#
  338.       GLOBAL.ULBYTES! = GLOBAL.ULBYTES! + BYTES.IN.FILE#
  339. '      CALL MUZAK (7)
  340.       CALL TIMEREMAIN (TIME.REMAINING!)
  341.       TIME.CREDITS! = TIME.CREDITS! + X!
  342.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!
  343.       IF PRIVATE.DOOR THEN _
  344.          X! = (X! - Q!) / 60.0 _
  345.        ELSE X! = (X! - TCA! + Q!)/60.0
  346.       X$ = STR$(FIX(X!*10.0))
  347.      X$ = LEFT$(X$,LEN(X$)-1) + "." + RIGHT$(X$,1)
  348.    IF X! > 1.0 THEN _
  349.      CALL QTPUT1 ("Uploads are appreciated here.  For today your") : _
  350.       CALL QTPUT1 ("SESSION & DAILY time limits increased by"+X$+" minutes")
  351.      GET.EXT.DESC = FALSE
  352.  IF AUTO.END = 1 THEN _
  353.     FILESYS.PARAMETER = 7 : _ 
  354.     DOWNLOAD.COMPLETED = TRUE 
  355.   EXIT SUB
  356. 20730 '          ---[ lock file ]---
  357.       IF EN$ = "" THEN _
  358.          RETURN
  359.       FMS.FORMAT = FALSE
  360.       IF EN$ = FMS.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  361.          FMS.FORMAT = TRUE _
  362.       ELSE CALL FINDIT (EN$) : _
  363.            IF OK THEN _
  364.               CALL READDIR (1) : _
  365.               IF EC = 0 THEN _
  366.                  FMS.FORMAT = (LEFT$(A$,4) = "\FMS")
  367.       IF NOT FMS.FORMAT THEN _
  368.          READ.BACKWARDS = FALSE : _
  369.          FIXED.LEN = 0 : _
  370.          B$ = DESC$ _
  371.       ELSE FIXED.LEN = 34 + MAX.DESC.LEN : _
  372.            B$ = DESC$ + _
  373.                 SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  374.                 UCAT$ + _
  375.                 SPACE$(3 - LEN(UCAT$)) : _
  376.            READ.BACKWARDS = TRUE : _
  377.            CALL FINDIT (EN$) : _
  378.            IF OK THEN _
  379.               CALL READDIR (2,1) : _
  380.               IF EC = 0 THEN _
  381.                  READ.BACKWARDS = (INSTR(A$," TOP ") = 0)
  382. CALL LOCKAPPND
  383.       IF EC <> 0 THEN _
  384.          GOTO  20731
  385.      '          ---[ append ]---
  386.       IF GET.EXT.DESC THEN _
  387.          IF READ.BACKWARDS THEN _
  388.             FOR I = LINES.IN.DESC TO 1 STEP -1 : _
  389.                GOSUB 20732 : _
  390.             NEXT
  391.       PRINT #2,USING "\           \########  &  &"; _
  392.                      FILE.NAME.HOLD$; _
  393.                      BYTES.IN.FILE#; _
  394.                      Z$; _
  395.                      B$
  396.       IF GET.EXT.DESC THEN _
  397.          IF NOT READ.BACKWARDS THEN _
  398.             FOR I = 1 TO LINES.IN.DESC : _
  399.                GOSUB 20732 : _
  400.             NEXT
  401.  20731 CALL UNLKAPPND
  402.       FIXED.LEN = 0
  403.       RETURN
  404. 20732 X$ = A$(I)
  405.       CALL TRIM (X$)
  406.       IF X$ = "" THEN _
  407.          RETURN
  408.       IF NOT FMS.FORMAT THEN _
  409.          PRINT #2,"  ";A$(I) : _
  410.          RETURN
  411.       IF FIXED.LEN > LEN(A$(I)) THEN _
  412.          X$ = SPACE$(FIXED.LEN - 1 - LEN(A$(I))) + "." _
  413.       ELSE X$ = ""
  414.       PRINT #2, "  ";LEFT$(A$(I),FIXED.LEN);X$
  415.       RETURN
  416. 20734 CALL FINDIT (FILE.NAME$)
  417. 20736 IF NOT OK THEN _
  418.          BYTES.IN.FILE# = 0.0_
  419.       ELSE BYTES.IN.FILE# = LOF(2)
  420.       IF BYTES.IN.FILE# < 2.0 THEN _
  421.          EXIT SUB
  422.       RETURN
  423.       END SUB
  424. 20741 ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  425. ' $PAGE
  426. '
  427. '  NAME    -- BADFILE
  428. '
  429. '  INPUTS  --     PARAMETER                    MEANING
  430. '               VIOLATION$
  431. '               VIOLATIONS.THIS.SESSION
  432. '               FILNAME$                      NAME OF FILE
  433. '
  434. '  OUTPUTS -- RESULT                      1 = FILE NAME IS OK
  435. '                                         2 = CHARACTER NOT ALLOWED
  436. '                                         3 = SYSTEM CRASH ATTEMPT
  437. '             VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  438. '             FILNAME$                    Gets capitalized
  439. '
  440. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  441. '             to either crash the system or to breach RBBS-PC's security.
  442. '
  443.       SUB BADFILE (FILNAME$,RESULT) STATIC
  444. '
  445. '
  446. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  447. '
  448. '
  449.       RESULT = 2
  450.       IF LEN(FILNAME$) < 1 THEN _
  451.          EXIT SUB
  452.       CALL BADFILECHAR (FILNAME$,OK)
  453.       IF NOT OK THEN _
  454.          EXIT SUB
  455.       IF RIGHT$(FILNAME$,1) = "." THEN _
  456.            EXIT SUB
  457.       CALL ALLCAPS (FILNAME$)
  458.       XX = INSTR(FILNAME$,".")
  459.       IF XX > 0 THEN _
  460.          XX = INSTR(XX + 1,FILNAME$,".") : _
  461.          IF XX > 0 THEN _
  462.             EXIT SUB
  463.       XX = LEN(FILNAME$)
  464.       IF XX => 3 THEN _
  465.          IF INSTR("PRN:CON:AUX:NUL:",FILNAME$) THEN _
  466.             GOTO 20742
  467.       IF XX => 4 THEN _
  468.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FILNAME$) THEN _
  469.             GOTO 20742
  470.       CALL BRKFNAME (FILNAME$,PRE$,BODY$,EXT$,FALSE)
  471.       IF LEN(PRE$) > 64 OR LEN(BODY$) > 8 OR LEN(BODY$) < 1 OR LEN(EXT$) > 3 THEN _
  472.          EXIT SUB
  473.       XX = LEN(BODY$)
  474.       IF XX => 3 THEN _
  475.          IF INSTR("PRN:CON:AUX:NUL:",BODY$) THEN _
  476.             GOTO 20742
  477.       IF XX => 4 THEN _
  478.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",BODY$) THEN _
  479.             GOTO 20742
  480.       RESULT = 1
  481.       EXIT SUB
  482. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  483.       VIOLATION$ = VIOLATION$ + _
  484.                    FILNAME$
  485.       RESULT = 3
  486.       END SUB
  487. '
  488. 21105 ' $SUBTITLE: 'LIBRARY - sub to support Library downloads'
  489. ' $PAGE
  490. '
  491. '  NAME    -- LIBRARY
  492. '
  493. '  INPUTS  --     PARAMETER                    MEANING
  494. '              SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  495. '                                       2 = CHANGE ACTIVE AREA
  496. '                                       3 = DISPLAY PC-SIG
  497. '                                           DISCLAIMER
  498. '                                       4 = ARCHIVE LIBRARY DISK
  499. '                                       5 = DOWNLOAD COMPLETED
  500. '              LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  501. '                                       1 = LIBRARY FROM PC-SIG
  502. '              LIBRARY.DRIVE$           LIBRARY DRIVE ID
  503. '
  504. '  OUTPUTS -- NONE
  505. '
  506. '  PURPOSE -- To provide access support for library drives
  507. '
  508.       SUB LIBRARY STATIC
  509.       STATIC LIBRARY.SUBDIR.NAME$(1)
  510.       STATIC DISK.TITLE$
  511.       EC = 0
  512.       IF LIBRARY.TYPE = 0 THEN _
  513.          EXIT SUB
  514.       IF LIBRARY.DISK.CHAR$ = "" THEN _
  515.          LIBRARY.DISK.CHAR$ = "0000"
  516.       ON SUBROUTINE.PARAMETER GOTO 21110, 21115, 21130, 21140, 21159
  517. 21110 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  518.          A$ = "No Library disk currently selected" _
  519.       ELSE A$ = "Library disk " + _
  520.                 LIBRARY.DISK.CHAR$ + _
  521.                 " selected - " + _
  522.                 DISK.TITLE$
  523.       CALL QTPUT1 (A$)
  524.       IF LIBRARY.DISK.ARCHIVE$ = "" THEN _
  525.          EXIT SUB
  526.       FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  527.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) <> "" THEN _
  528.             CALL QTPUT1 (LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) + _
  529.                        "." + DEFAULT.EXTENSION$ + " ready for transmission!")
  530.       NEXT
  531.       EXIT SUB
  532. 21115 IF Q = 1 THEN _
  533.          A$ = "Change Library disk from " + _
  534.               LIBRARY.DISK.CHAR$ + _
  535.               " to (1 -" + _
  536.               STR$(LIBRARY.MAX.DISK) + _
  537.               ")" : _
  538.          SUBROUTINE.PARAMETER = 1 : _
  539.          CALL TGET : _
  540.          IF SUBROUTINE.PARAMETER = -1 THEN _
  541.             EXIT SUB _
  542.          ELSE IF Q = 0 THEN _
  543.                  LIBRARY.DISK.CHAR$ = "0000" : _
  544.                  CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  545.                                   "\" : _
  546.                  GOTO 21126
  547. 21117 IF VAL(B$(Q)) < 1 OR VAL(B$(Q)) > LIBRARY.MAX.DISK THEN _
  548.          Q = 1 : _
  549.          GOTO 21115
  550. 21120 LIBRARY.DISK.CHAR$ = B$(Q)
  551.       CLOSE 2
  552.       LIBRARY.DISK.CHAR$ = RIGHT$("0000" + LIBRARY.DISK.CHAR$,4)
  553. 21121 CALL FINDIT("RBBS-CDR.DEF")
  554.       IF EC <> 0 THEN _
  555.          EXIT SUB
  556. 21122 IF EOF(2) THEN _
  557.          LIBRARY.DISK.CHAR$ = "" : _
  558.          EXIT SUB
  559.       INPUT #2,WORK.SUBDIR$,CHDIR.LIBRARY$
  560.       LINE INPUT #2,DISK.TITLE$
  561.       IF LIBRARY.DISK.CHAR$ = WORK.SUBDIR$ THEN _
  562.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  563.                           CHDIR.LIBRARY$ : _
  564.          GOTO 21126
  565.       GOTO 21122
  566. 21126 EC = 0
  567.       CALL CHANGEDIR (CHDIR.LIBRARY$)
  568.       IF EC <> 0 THEN _
  569.          LIBRARY.DISK.CHAR$ = "0000" : _
  570.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  571.                           "\" : _
  572.          GOTO 21126
  573.       EXIT SUB
  574. 21130 IF LIBRARY.TYPE <> 1 THEN _
  575.          EXIT SUB
  576.       CALL SKIPLINE(1)
  577.       A$ = "PC-SIG Library is being accessed.  The file that you are about"
  578.       CALL QTPUT1 (A$)
  579.       A$ = "to download can also be obtained by ordering DISK " + _
  580.            LIBRARY.DISK.CHAR$
  581.       CALL QTPUT1 (A$)
  582.       A$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  583.       CALL QTPUT (A$,2)
  584.       EXIT SUB
  585. 21140 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  586.          CALL QTPUT1 ("You must select a LIBRARY disk first!") : _
  587.          EXIT SUB
  588.       A$ = "Archive contents of Library disk - " + _
  589.            LIBRARY.DISK.CHAR$ + _
  590.            " for data transmission (Y/[N])"
  591.       SUBROUTINE.PARAMETER = 1
  592.       CALL TGET
  593.       IF NOT LOCAL.USER THEN _
  594.          IF SUBROUTINE.PARAMETER = -1 THEN _
  595.             EXIT SUB
  596.       IF NOT YES THEN _
  597.          EXIT SUB
  598. 21145 CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  599.                     LIBRARY.NODE.ID$ + _
  600.                     "DK*." + DEFAULT.EXTENSION$)
  601. 21150 CALL QTPUT1 ("Work/RAM disk has been purged")
  602.       CALL QTPUT1 ("Beginning archive using " + _
  603.                   LIBRARY.ARCHIVE.PROGRAM$ + _
  604.                   " Please be patient!")
  605.       REDIM LIBRARY.SUBDIR.NAME$(10)
  606.       LIBRARY.SUBDIR.CHAR$ = ""
  607.       LIBRARY.LOOP.COUNT = 0
  608.       GOSUB 21157
  609.       A$ = "Contents of Library disk - " + _
  610.            LIBRARY.DISK.CHAR$ + _
  611.            " now archived for data transmission"
  612.       CALL QTPUT1 (A$)
  613.       A$ = "Searching for Sub-directories"
  614.       CALL QTPUT1 (A$)
  615.       GOSUB 21158
  616.       LIBRARY.DISK.ARCHIVE$ = LIBRARY.DISK.CHAR$
  617. '
  618. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  619. '
  620.       TREEDIR$ = LIBRARY.WORK.DISK.PATH$ + _
  621.                  LIBRARY.NODE.ID$ + _
  622.                  "DKDIR.LST"
  623.       DIRCMD$ = "DIR " + _
  624.                 LIBRARY.DRIVE$ + _
  625.                 " | FIND " +  _
  626.                 CHR$(34) + _
  627.                 " <DIR> " + _
  628.                 CHR$(34) + _
  629.                 "  > " + _
  630.                 TREEDIR$
  631. 21151 SHELL DIRCMD$
  632.       CALL SKIPLINE (2)
  633.       LOCATE 24,1
  634.       EC = 0
  635. 21152 CLOSE 2
  636. 21153 CALL OPENWORK (2,TREEDIR$)
  637.       LIBRARY.SUBDIR.COUNT = 0
  638.       WHILE NOT EOF(2)
  639.          LINE INPUT #2, DIRREC$
  640.          IF LEFT$(DIRREC$,1) <> "." THEN _
  641.             LIBRARY.SUBDIR.COUNT = LIBRARY.SUBDIR.COUNT + 1 : _
  642.             LIBRARY.SUBDIR.NAME$(LIBRARY.SUBDIR.COUNT) = _
  643.             LEFT$(DIRREC$,8)
  644.       WEND
  645.       CLOSE 2
  646.       LIBRARY.LOOP.COUNT = 1
  647.       IF LIBRARY.SUBDIR.COUNT = 0 THEN _
  648.          GOTO 21156
  649.       A$ = "There are" + STR$(LIBRARY.SUBDIR.COUNT) + _
  650.            " Subdirectories on LIBRARY disk - " + _
  651.            LIBRARY.DISK.CHAR$
  652.       CALL QTPUT1 (A$)
  653.       FOR LIBRARY.LOOP.COUNT = 1 TO LIBRARY.SUBDIR.COUNT
  654.          IF NOT LOCAL.USER THEN _
  655.             CALL CARRIER : _
  656.             IF SUBROUTINE.PARAMETER THEN _
  657.                GOTO 21155
  658.          LIBRARY.SUBDIR.CHAR$ = MID$("ABCDEFGHI",LIBRARY.LOOP.COUNT,1)
  659.          A$ = "Creating " + _
  660.               LIBRARY.NODE.ID$ + _
  661.               "DK" + _
  662.               LIBRARY.DISK.CHAR$ + _
  663.               LIBRARY.SUBDIR.CHAR$ + _
  664.               ".ARC using " + LIBRARY.ARCHIVE.PROGRAM$
  665.          CALL QTPUT1 (A$)
  666.          CHDIR CHDIR.LIBRARY$ + _
  667.                "\" + _
  668.                LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT)
  669.          GOSUB 21157
  670.          A$ = "Disk - " + _
  671.               LIBRARY.DISK.CHAR$ + _
  672.               "; Subdirectory" + _
  673.               " -" + _
  674.               STR$(LIBRARY.LOOP.COUNT) + _
  675.               " has been archived for data transmission"
  676.          CALL QTPUT1 (A$)
  677.          GOSUB 21158
  678. 21155 NEXT LIBRARY.LOOP.COUNT
  679. 21156 CALL CARRIER
  680.       A$ = ""
  681.       EXIT SUB
  682. 21157 LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE.PATH$ + _
  683.                        LIBRARY.ARCHIVE.PROGRAM$ + _
  684.                        " " + _
  685.                        LIBRARY.WORK.DISK.PATH$ + _
  686.                        LIBRARY.NODE.ID$ + _
  687.                        "DK" + _
  688.                        LIBRARY.DISK.CHAR$ + _
  689.                        LIBRARY.SUBDIR.CHAR$ + _
  690.                        " " + _
  691.                        LIBRARY.DRIVE$ + _
  692.                        "*.*"
  693.       IF USE.DEVICE.DRIVER$ <> "" AND FOSSIL THEN _
  694.          LIBRARY.ARCHIVE$ = DISK.FOR.DOS$ + _
  695.                             "COMMAND /C " + _
  696.                             LIBRARY.ARCHIVE$ + _
  697.                             " > " + _
  698.                             USE.DEVICE.DRIVER$
  699.       SHELL LIBRARY.ARCHIVE$
  700.       CALL SKIPLINE (2)
  701.       LOCATE 24,1
  702.       RETURN
  703. 21158 LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT) = LIBRARY.NODE.ID$ + _
  704.                                              "DK" + _
  705.                                              LIBRARY.DISK.CHAR$ + _
  706.                                              LIBRARY.SUBDIR.CHAR$
  707.       RETURN
  708. 21159 FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  709.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = A$ THEN _
  710.             LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = ""
  711.       NEXT
  712.       END SUB
  713. 21598 ' $SUBTITLE: 'XFERTYPE - sub to identify file xfer protocol'
  714. ' $PAGE
  715. '
  716. '  NAME    -- XFERTYPE
  717. '
  718. '  INPUTS  --     PARAMETER                    MEANING
  719. '               INDEX            = 1       Manual select for up/download
  720. '                                = 2       Default select
  721. '                                = 3       Set transfer default
  722. '               A$
  723. '               B$(1)
  724. '               Q
  725. '               RELIABLE.MODE
  726. '               TRANSFER.OPTIONS$
  727. '               USER.TRANSFER.DEFAULT$
  728. '               XFER.SUPPORT
  729. '
  730. '  OUTPUTS   -- CHECKSUM
  731. '               FLEN
  732. '               FT$
  733. '
  734. '  PURPOSE -- To identify the file transfer protocol (either
  735. '             from the user's default or via explicit selection)
  736. '
  737.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  738.       IF TRANSFER.OPTIONS$ = "" OR USER.SECURITY.LEVEL <> PREV.USL THEN _
  739.          CALL PROTOCOL : _
  740.          PREV.USL = USER.SECURITY.LEVEL
  741.       X$ = A$ + "Protocol"
  742.       ON INDEX GOTO 21600,21620,21600                                ' KG081201
  743. '
  744. '
  745. ' *  MANUAL SELECT OF TRANSFER PROTOCOL
  746. '
  747. '
  748. 21600 IF SKIP.HELP THEN _
  749.          GOTO 21604
  750. 21602 CALL BUFFILE (HELP.PATH$ + "UF" + HELP.EXTENSION$,X)
  751.       IF SUBROUTINE.PARAMETER = -1 THEN _
  752.          EXIT SUB
  753. 21604 STOP.INTERRUPTS = TRUE                                         ' KG081201
  754.       IF INDEX = 3 THEN _                                            ' KG081201
  755.          IF ANS.INDEX < LAST.INDEX THEN _                            ' KG081201
  756.             GOTO 21605                                               ' KG081201
  757.       CALL QTPUT1 (X$)
  758.       CALL BUFSTRNG (TRANSFER.OPTIONS$,4096,X)                       ' KG081201
  759.       CALL QTPUT (MID$("?!",1-TURBO.KEY.USER,1)+" ",0)               ' KG081201
  760. 21605 A$ = ""
  761.       TURBO.KEY = -TURBO.KEY.USER                                    ' KG081201
  762.       MACRO.MIN = 2
  763.       SUBROUTINE.PARAMETER = 1
  764.       IF INDEX = 3 THEN _                                            ' KG081201
  765.          CALL POPCSTACK : _                                          ' KG081201
  766.          X = ANS.INDEX _                                             ' KG081201
  767.       ELSE SUBROUTINE.PARAMETER = 1 : _                              ' KG081201
  768.            CALL TGET : _                                             ' KG081201
  769.            X = 1                                                     ' KG081201
  770.       IF SUBROUTINE.PARAMETER = -1 THEN _
  771.          EXIT SUB
  772.       IF Q = 0 THEN _
  773.          GOTO 21604
  774. 21606 Z$ = B$(X)                                                     ' KG081201
  775. '
  776. '
  777. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL
  778. '
  779. '
  780. 21610 CALL ALLCAPS (Z$)
  781.       IF INSTR("H?",Z$) > 0 THEN _
  782.          GOTO 21602
  783.       FF = INSTR(DFLTXFER$,Z$)
  784.       IF FF < 1 THEN _
  785.          GOTO 21600
  786. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  787.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  788.       GOTO 21621
  789. 21620 FF = -1
  790.       IF COMMAND.TRANSFER$ <> "" THEN _
  791.          Z$ = COMMAND.TRANSFER$ : _
  792.          GOTO 21610
  793.       X = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  794.       IF X > 0 THEN _
  795.          IF MID$(INTERNAL.EQUIV$,X,1) <> "N" THEN _
  796.             Z$ = USER.TRANSFER.DEFAULT$ : _
  797.             GOTO 21610
  798.       PROTO.PROMPT$ = "None"
  799.       FF = 0
  800.       EXIT SUB
  801. 21621 IF FF = PREV.FF AND PREV.PROTO.DEF$ = PROTO.DEF$ THEN _
  802.          PROTO.PROMPT$ = PREV.PROTO.PROMPT$ : _
  803.          EXIT SUB
  804.       PREV.FF = FF
  805.       PREV.PROTO.DEF$ = PROTO.DEF$
  806.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  807.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  808.       CALL FINDIT (PROTO.DEF$)
  809.       IF OK THEN _
  810.          GOTO 21623
  811.       X = INSTR("AXCYN",INTERNAL.PROTO$)
  812.       IF X < 1 THEN _
  813.          INTERNAL.PROTO$ = "N"
  814.       PROTO.PROMPT$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",INTERNAL.PROTO$)-9,10)
  815.       CALL TRIMTRAIL (PROTO.PROMPT$," ")
  816.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  817.       FLEN = 128 - 896 * (INTERNAL.PROTO$ = "Y")
  818.       BLOCK.SIZE = FLEN
  819.       IF INTERNAL.PROTO$ = "Y" THEN _
  820.          SPEED.FACTOR! = 0.87 _
  821.       ELSE IF INTERNAL.PROTO$ = "A" THEN _
  822.          SPEED.FACTOR! = 0.92 _
  823.       ELSE SPEED.FACTOR! = 0.78
  824.       GOTO 21625
  825. 21623 CALL READPARMS (WORK.ARA$(),13,FF)
  826.       IF EC > 0 THEN _
  827.          FF = LEN(DFLTXFER$) : _
  828.          PROTO.PROMPT$ = "None" : _                                  ' KG081401
  829.          GOTO 21625                                                  ' KG081401
  830.       PROTO.PROMPT$ = WORK.ARA$(1)
  831.       IF LEN(PROTO.PROMPT$) > 2 THEN _
  832.          IF MID$(PROTO.PROMPT$,2,1) = ")" THEN _
  833.             PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,1) + MID$(PROTO.PROMPT$,3)
  834.       X = INSTR(PROTO.PROMPT$+CRLF$,CRLF$)
  835.       PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,X-1)
  836.       CALL TRIM (PROTO.PROMPT$)
  837.       PROTO.METHOD$ = LEFT$(WORK.ARA$(3),1)
  838.       CALL ALLCAPS (PROTO.METHOD$)
  839.       REQ.8.BIT = (LEFT$(WORK.ARA$(4),1) = "8")
  840.       DOWN.TEMPLATE$ = WORK.ARA$(12)
  841.       UP.TEMPLATE$ = WORK.ARA$(13)
  842.       X$ = WORK.ARA$(11)
  843.       X = INSTR(X$,"=")
  844.       ADVANCE.PROTO.WRITE = FALSE
  845.       IF X < 2 OR X >= LEN(X$) THEN _
  846.          FAILURE.PARM = 4 : _
  847.          FAILURE.STRING$ = "F" _
  848.       ELSE FAILURE.PARM = VAL(LEFT$(X$,X-1)) : _
  849.            FAILURE.STRING$ = MID$(X$,X+1) : _
  850.            X = INSTR(FAILURE.STRING$,"=") : _
  851.            IF X > 0 THEN _
  852.               ADVANCE.PROTO.WRITE = (MID$(FAILURE.STRING$,X) = "=A") : _
  853.               FAILURE.STRING$ = LEFT$(FAILURE.STRING$,X-1)
  854.       PROTO.MACRO$ = WORK.ARA$(10)
  855.       FAKE.XRPT = (LEFT$(WORK.ARA$(8),1) = "F")
  856.       BATCH.PROTO = (LEFT$(WORK.ARA$(6),1) = "B")
  857.       SPEED.FACTOR! = VAL(WORK.ARA$(9))
  858.       IF SPEED.FACTOR! < 0.1 THEN _
  859.          SPEED.FACTOR! = 0.87
  860.       BLOCK.SIZE = VAL(WORK.ARA$(7))
  861.       FLEN = BLOCK.SIZE
  862.       IF FLEN < 1 THEN _
  863.          FLEN = 128
  864. 21625 PREV.PROTO.PROMPT$ = PROTO.PROMPT$
  865.       END SUB
  866. 21993 ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  867. ' $PAGE
  868. '
  869. '  NAME    -- FILELOCK
  870. '
  871. '  INPUTS  --     PARAMETER                    MEANING
  872. '             SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  873. '                                    2 FLUSH MESSAGE RECORD TO DISK
  874. '                                      AND UNLOCK MESSAGES
  875. '                                    3 LOCK MESSAGE FILE
  876. '                                    4 UNLOCK MESSAGE FILE
  877. '                                    5 LOCK USER FILE
  878. '                                    6 LOCK 4 RECORD BLOCK IN USER
  879. '                                      FILE
  880. '                                    7 UNLOCK USER FILE
  881. '                                    8 UNLOCK 4 RECORD BLOCK IN USER
  882. '                                      FILE
  883. '                                    9 LOCK UPLOAD DIRECTORY OR
  884. '                                      COMMENTS FILE
  885. '                                   10 UNLOCK UPLOAD DIRECTORY OR
  886. '                                      COMMENTS FILE
  887. '               ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  888. '               ACTIVE.USER.FILE$      NAME OF USER FILE
  889. '               CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  890. '               EN$                    UPLOAD DIRECTORY OR COMMENTS
  891. '                                      FILE NAME TO LOCK/UNLOCK
  892. '               NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  893. '
  894. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  895. '             BLK
  896. '             LOCK.DRIVE
  897. '             LOCK.FILE.NAME$
  898. '             LOCK.STATUS$
  899. '             MESSAGE.FILE.LOCK
  900. '             USER.BLOCK.LOCK
  901. '             USER.FILE.LOCK
  902. '             USER.FILE.INDEX
  903. '
  904. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  905. '             multiple copies of RBBS-PC are sharing the same
  906. '             files in either a multi-tasking DOS environment or
  907. '             in a local area network environment
  908. '
  909.       SUB FILELOCK STATIC
  910.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000, _
  911.                                     26500,27000,27500,29000,29500
  912.       EXIT SUB
  913. '
  914. '
  915. ' *  UNLOCK USERS AND MESSAGES
  916. '
  917. '
  918. 21995 GOSUB 27000
  919.       GOSUB 25000
  920.       RETURN
  921. '
  922. '
  923. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  924. '
  925. '
  926. 21996 CLOSE 1
  927.       IF SHARE.IT THEN _
  928.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  929.       ELSE OPEN "I",1,CONFIG.FILENAME$
  930. '
  931. '
  932. ' *  UNLOCK MESSAGES
  933. '
  934. '
  935.       GOSUB 25000
  936.       CALL OPENMSG
  937.       RETURN
  938. '
  939. '
  940. ' *  LOCK MESSAGE FILE
  941. '
  942. '
  943. 22000 IF MESSAGE.FILE.LOCK = TRUE THEN _
  944.          RETURN
  945.       MESSAGE.FILE.LOCK = TRUE
  946.       MID$(LOCK.STATUS$,1,2) = "LM"
  947.       SUBROUTINE.PARAMETER = 2
  948.       CALL LINE25
  949.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  950.       ON NETWORK.TYPE GOTO 22100,22200,22300,22400,22500,29700
  951.       RETURN
  952. '
  953. '
  954. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  955. '
  956. '
  957. 22100 AX = &H0
  958.       BX = &H1
  959.       IF MULTI.LINK.PRESENT > 0 THEN _
  960.          CALL RBBSML(AX,BX)
  961.       RETURN
  962. '
  963. '
  964. ' *  LOCK MESSAGE FILE (OMNINET)
  965. '
  966. '
  967. 22200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  968.       CC$ = CHR$(1) + _
  969.             LEFT$(FPREFIX$ + SPACE$(8),8)
  970.       GOSUB 28000
  971.       IF CT = 0 THEN _
  972.          RETURN
  973.       CALL DELAYIT (1)
  974.       GOTO 22200
  975. '
  976. '
  977. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  978. ' *  LOCK USER FILE (ORCHID PC-NET)
  979. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  980. '
  981. '
  982. 22300 GOSUB 28100
  983.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  984.       RETURN
  985. '
  986. '
  987. ' *  LOCK SYSTEM (DESQview)
  988. '
  989. '
  990. 22400 CALL DVLOCK("MESSAGE")
  991.       RETURN
  992. '
  993. '
  994. ' *  LOCK MESSAGE FILE (10 NET)
  995. ' *  LOCK USER FILE (10 NET)
  996. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  997. '
  998. '
  999. 22500 GOSUB 28100
  1000.       CALL LPLK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1001.       RETURN
  1002. '
  1003. '
  1004. ' *  UNLOCK MESSAGE FILE
  1005. '
  1006. '
  1007. 25000 IF NOT MESSAGE.FILE.LOCK THEN _
  1008.          RETURN
  1009.       MESSAGE.FILE.LOCK = FALSE
  1010.       MID$(LOCK.STATUS$,1,2) = "UM"
  1011.       SUBROUTINE.PARAMETER = 2
  1012.       CALL LINE25
  1013.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1014.       ON NETWORK.TYPE GOTO 25100,25200,25300,25400,25500,29800
  1015.       RETURN
  1016. '
  1017. '
  1018. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1019. '
  1020. '
  1021. 25100 AX = &H100
  1022.       BX = &H1
  1023.       IF MULTI.LINK.PRESENT > 0 THEN _
  1024.          CALL RBBSML(AX,BX)
  1025.       RETURN
  1026. '
  1027. '
  1028. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1029. '
  1030. '
  1031. 25200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1032.       CC$ = CHR$(17) + _
  1033.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1034.       GOSUB 28000
  1035.       IF CT = 128 THEN _
  1036.          RETURN
  1037.       CALL DELAYIT (1)
  1038.       GOTO 25200
  1039. '
  1040. '
  1041. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1042. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1043. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  1044. '
  1045. '
  1046. 25300 GOSUB 28100
  1047.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1048.       RETURN
  1049. '
  1050. '
  1051. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1052. '
  1053. '
  1054. 25400 CALL DVUNLOCK("MESSAGE")
  1055.       RETURN
  1056. '
  1057. '
  1058. ' *  UNLOCK MESSAGE FILE (10 NET)
  1059. ' *  UNLOCK USER FILE (10 NET)
  1060. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  1061. '
  1062. '
  1063. 25500 GOSUB 28100
  1064.       CALL UNLOK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1065.       RETURN
  1066.  
  1067. '
  1068. '
  1069. ' *  LOCK USER FILE
  1070. '
  1071. '
  1072. 26000 IF USER.FILE.LOCK = TRUE THEN _
  1073.          RETURN
  1074.       USER.FILE.LOCK = TRUE
  1075.       MID$(LOCK.STATUS$,4,2) = "LU"
  1076.       SUBROUTINE.PARAMETER = 2
  1077.       CALL LINE25
  1078.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1079.       ON NETWORK.TYPE GOTO 26100,26200,22300,26300,22500,29720
  1080.       RETURN
  1081. '
  1082. '
  1083. ' *  LOCK USER FILE (MULTI-LINK)
  1084. '
  1085. '
  1086. 26100 AX = &H0
  1087.       BX = &H2
  1088.       IF MULTI.LINK.PRESENT > 0 THEN _
  1089.          CALL RBBSML(AX,BX)
  1090.       RETURN
  1091. '
  1092. '
  1093. ' *  LOCK USER FILE (OMNINET)
  1094. '
  1095. '
  1096. 26200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1097.       CC$ = CHR$(1) + _
  1098.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1099.       GOSUB 28000
  1100.       IF CT = 0 THEN _
  1101.          RETURN
  1102.       CALL DELAYIT (1)
  1103.       GOTO 26200
  1104. '
  1105. '
  1106. ' *  LOCK USER FILE (DESQVIEW)
  1107. '
  1108. '
  1109. 26300 CALL DVLOCK("USER")
  1110.       RETURN
  1111. '
  1112. '
  1113. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1114. '
  1115. '
  1116. 26500 IF USER.BLOCK.LOCK = TRUE THEN _
  1117.          RETURN
  1118.       USER.BLOCK.LOCK = TRUE
  1119.       BLK = (USER.FILE.INDEX / 4) + .26
  1120.       MID$(LOCK.STATUS$,7,2) = "LB"
  1121.       SUBROUTINE.PARAMETER = 2
  1122.       CALL LINE25
  1123.       ON NETWORK.TYPE GOTO 26600,26700,26800,26750,26900,29730
  1124.       RETURN
  1125. '
  1126. '
  1127. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1128. '
  1129. '
  1130. 26600 AX = &H0
  1131.       BX = BLK + 10
  1132.       IF MULTI.LINK.PRESENT > 0 THEN _
  1133.          CALL RBBSML(AX,BX)
  1134.       RETURN
  1135. '
  1136. '
  1137. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1138. '
  1139. '
  1140. 26700 CC$ = CHR$(1) + _
  1141.             "BLK" + _
  1142.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1143.       GOSUB 28000
  1144.       IF CT = 0 THEN _
  1145.          RETURN
  1146.       CALL DELAYIT (1)
  1147.       GOTO 26700
  1148. '
  1149. '
  1150. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1151. '
  1152. '
  1153. 26750 CALL DVLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1154.       RETURN
  1155. '
  1156. '
  1157. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1158. '
  1159. '
  1160. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1161.                         "BLK" + _
  1162.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1163.       GOTO 22300
  1164. '
  1165. '
  1166. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1167. '
  1168. '
  1169. 26900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1170.                         "BLK" + _
  1171.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1172.       GOTO 22500
  1173. '
  1174. '
  1175. ' *  UNLOCK USER FILE
  1176. '
  1177. '
  1178. 27000 IF NOT USER.FILE.LOCK THEN _
  1179.          RETURN
  1180.       USER.FILE.LOCK = FALSE
  1181.       MID$(LOCK.STATUS$,4,2) = "UU"
  1182.       SUBROUTINE.PARAMETER = 2
  1183.       CALL LINE25
  1184.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1185.       ON NETWORK.TYPE GOTO 27100,27200,25300,27300,25500,29820
  1186.       RETURN
  1187. '
  1188. '
  1189. ' *  UNLOCK USER FILE (MULTI-LINK)
  1190. '
  1191. '
  1192. 27100 AX = &H100
  1193.       BX = &H2
  1194.       IF MULTI.LINK.PRESENT > 0 THEN _
  1195.          CALL RBBSML(AX,BX)
  1196.       RETURN
  1197. '
  1198. '
  1199. ' *  UNLOCK USER FILE (OMNINET)
  1200. '
  1201. '
  1202. 27200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1203.       CC$ = CHR$(17) + _
  1204.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1205.       GOSUB 28000
  1206.       IF CT = 128 THEN _
  1207.          RETURN
  1208.       CALL DELAYIT (1)
  1209.       GOTO 27200
  1210. '
  1211. '
  1212. ' *  UNLOCK USER FILE (DESQVIEW)
  1213. '
  1214. '
  1215. 27300 CALL DVUNLOCK("USER")
  1216.       RETURN
  1217. '
  1218. '
  1219. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1220. '
  1221. '
  1222. 27500 IF NOT USER.BLOCK.LOCK THEN _
  1223.          RETURN
  1224.       USER.BLOCK.LOCK = FALSE
  1225.       BLK = (USER.FILE.INDEX / 4) + .26
  1226.       MID$(LOCK.STATUS$,7,2) = "UB"
  1227.       SUBROUTINE.PARAMETER = 2
  1228.       CALL LINE25
  1229.       ON NETWORK.TYPE GOTO 27600,27700,27800,27750,27900,29830
  1230.       RETURN
  1231. '
  1232. '
  1233. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1234. '
  1235. '
  1236. 27600 AX = &H100
  1237.       BX = BLK + 10
  1238.       IF MULTI.LINK.PRESENT > 0 THEN _
  1239.          CALL RBBSML(AX,BX)
  1240.       RETURN
  1241. '
  1242. '
  1243. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1244. '
  1245. '
  1246. 27700 CC$ = CHR$(17) + _
  1247.             "BLK" + _
  1248.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1249.       GOSUB 28000
  1250.       IF CT = 128 THEN _
  1251.          RETURN
  1252.       CALL DELAYIT (1)
  1253.       GOTO 27700
  1254. '
  1255. '
  1256. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1257. '
  1258. '
  1259. 27750 CALL DVUNLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1260.       RETURN
  1261. '
  1262. '
  1263. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1264. '
  1265. '
  1266. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1267.                         "BLK" + _
  1268.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1269.       GOTO 25300
  1270. '
  1271. '
  1272. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1273. '
  1274. '
  1275. 27900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1276.                         "BLK" + _
  1277.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1278.       GOTO 25500
  1279. '
  1280. '
  1281. ' *  CORVUS OMNINET INTERFACE
  1282. '
  1283. '
  1284. 28000 CC$ = LINE.FEED$ + _
  1285.             CHR$(0) + _
  1286.             CHR$(11) + _
  1287.             CC$
  1288.       CALL CDSEND(CC$)
  1289.       CALL CDRECV(CN$)
  1290.       CT = ASC(MID$(CN$,3,1))
  1291.       IF CT => 128 THEN _
  1292.          CALL LPRNT("CORVUS LOCK FAIL",1) : _
  1293.          SUBROUTINE.PARAMETER = -1
  1294. 28010 CT = ASC(MID$(CN$,4,1))
  1295.       IF CT => 129 THEN _
  1296.          CALL LPRNT("CORVUS FULL",1) : _
  1297.          SUBROUTINE.PARAMETER = -1
  1298.       RETURN
  1299. '
  1300. '
  1301. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1302. '
  1303. '
  1304. 28100 CALL ALLCAPS (LOCK.FILE.NAME$)
  1305.       LOCK.DRIVE = ASC(LEFT$(LOCK.FILE.NAME$,1)) - ASC("A")
  1306.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1307.                         STRING$(32 - LEN(LOCK.FILE.NAME$),0)
  1308.       A = 0
  1309.       RETURN
  1310. '
  1311. '
  1312. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1313. '
  1314. '
  1315. 29000 IF LOCKED.EN$ = EN$ THEN _
  1316.          RETURN
  1317.       LOCKED.EN$ = EN$
  1318.       MID$(LOCK.STATUS$,10,2) = "LD"
  1319.       SUBROUTINE.PARAMETER = 2
  1320.       CALL LINE25
  1321.       LOCK.FILE.NAME$ = EN$
  1322.       ON NETWORK.TYPE GOTO 29100,29010,22300,29300,22500,29710
  1323. 29010 RETURN
  1324. '
  1325. '
  1326. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1327. '
  1328. '
  1329. 29100 AX = &H0
  1330.       BX = &H3
  1331.       IF MULTI.LINK.PRESENT > 0 THEN _
  1332.          CALL RBBSML(AX,BX)
  1333.       RETURN
  1334. '
  1335. '
  1336. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1337. '
  1338. '
  1339. 29300 CALL DVLOCK("MISC")
  1340.       RETURN
  1341. '
  1342. '
  1343. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1344. '
  1345. '
  1346. 29500 IF LOCKED.EN$ <> EN$ THEN _
  1347.          RETURN
  1348.       LOCKED.EN$ = ""
  1349.       MID$(LOCK.STATUS$,10,2) = "UD"
  1350.       SUBROUTINE.PARAMETER = 2
  1351.       CALL LINE25
  1352.       LOCK.FILE.NAME$ = EN$
  1353.       ON NETWORK.TYPE GOTO 29600,29510,25300,29650,25500,29810
  1354. 29510 RETURN
  1355. '
  1356. '
  1357. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1358. '
  1359. '
  1360. 29600 AX = &H100
  1361.       BX = &H3
  1362.       IF MULTI.LINK.PRESENT > 0 THEN _
  1363.          CALL RBBSML(AX,BX)
  1364.       EXIT SUB
  1365. '
  1366. '
  1367. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1368. '
  1369. '
  1370. 29650 CALL DVUNLOCK("MISC")
  1371.       RETURN
  1372. '
  1373. '
  1374. ' *  NETBIOS SEMAPHORE LOCK MECHANISM
  1375. ' *     Only the USERS file is actually locked.  All other files are locked
  1376. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1377. ' *     file semaphore as follows:
  1378. ' *        RECORD 1 = MESSAGES file lock status
  1379. ' *        RECORD 2 = Comments/Upload dir locked
  1380. ' *        RECORD 3 = entire USERS file lock
  1381. '
  1382. '
  1383. ' * Lock MESSAGES
  1384. 29700 CALL NETBIOS (1,6,1)
  1385.       RETURN
  1386.  
  1387. ' * Lock Comments/Upload dir
  1388. 29710 CALL NETBIOS (1,6,2)
  1389.       RETURN
  1390.  
  1391. ' * Lock USERS file
  1392. 29720 CALL NETBIOS (1,6,3)
  1393.       RETURN
  1394.  
  1395. ' * Lock single USERS record
  1396. 29730 CALL NETBIOS (1,6,3)
  1397.       RETURN
  1398.  
  1399. ' * UNLOCK MESSAGES
  1400. 29800 CALL NETBIOS (0,6,1)
  1401.       RETURN
  1402.  
  1403. ' * UNLOCK Comments/Upload dir
  1404. 29810 CALL NETBIOS (0,6,2)
  1405.       RETURN
  1406.  
  1407. ' * UNLOCK USERS file
  1408. 29820 CALL NETBIOS (0,6,3)
  1409.       RETURN
  1410.  
  1411. ' * UNLOCK single USERS record
  1412. 29830 CALL NETBIOS (0,6,3)
  1413.       RETURN
  1414.       END SUB
  1415. 30000 ' $SUBTITLE: 'INITIBM - sub to create/open NETBIOS semaphore file'
  1416. ' $PAGE
  1417. '
  1418. '  NAME    -- INITIBM   (Written by Doug Azzarito)
  1419. '
  1420. '  INPUTS  -- NONE
  1421. '
  1422. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1   ABORT RBBS
  1423. '
  1424. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1425. '             Create file if it does not exits.
  1426. '
  1427.       SUB INITIBM STATIC
  1428. '
  1429. '
  1430. ' *  SEE IF FILE EXISTS
  1431. '
  1432. '
  1433.       SHARE.IT = TRUE
  1434.       FOR I = LEN(MAIN.MESSAGE.FILE$) TO 0 STEP -1
  1435.          IF I = 0 THEN _
  1436.             GOTO 30010
  1437.          IF MID$(MAIN.MESSAGE.FILE$,I,1) = ":" OR _
  1438.             MID$(MAIN.MESSAGE.FILE$,I,1) = "\" THEN _
  1439.             GOTO 30010
  1440.       NEXT
  1441. 30010 IBM.FLAG.FILE$ = LEFT$(MAIN.MESSAGE.FILE$,I) + _
  1442.                        "IBMFLAGS"
  1443.       CALL FINDIT (IBM.FLAG.FILE$)
  1444.       CLOSE 2
  1445.       IF OK THEN _
  1446.          GOTO 30020
  1447. '
  1448. '
  1449. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1450. '
  1451. '
  1452.       OPEN IBM.FLAG.FILE$ ACCESS WRITE AS #6 LEN=2
  1453.       FIELD 6, 2 AS LOCKBUF$
  1454.       LSET LOCKBUF$ = MKI$(0)
  1455.       FOR I = 1 TO 3
  1456.          PUT 6
  1457.       NEXT
  1458.       CLOSE #6
  1459. 30020 OPEN IBM.FLAG.FILE$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1460.       END SUB
  1461. 30500 ' $SUBTITLE: 'OPENMSG - open the MESSAGES file'
  1462. ' $PAGE
  1463. '
  1464. '  NAME    -- OPENMSG
  1465. '
  1466. '  INPUTS  --     PARAMETER                    MEANING
  1467. '              ACTIVE.MESSAGE.FILE$
  1468. '              SHARE.IT
  1469. '
  1470. '  OUTPUTS --  MESSAGE.RECORD$
  1471. '
  1472.       SUB OPENMSG STATIC
  1473. '
  1474. '
  1475. ' *  OPEN AND DEFINE MESSAGE FILE
  1476. '
  1477. '
  1478.      CLOSE 1
  1479.       IF SHARE.IT THEN _
  1480.          OPEN ACTIVE.MESSAGE.FILE$ ACCESS READ WRITE SHARED AS #1 _
  1481.       ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
  1482.       FIELD 1,128 AS MESSAGE.RECORD$
  1483.       END SUB
  1484. 30595 ' $SUBTITLE: 'FINDFUNC - sub to handle local keyboard functions'
  1485. ' $PAGE
  1486. '
  1487. '  NAME    -- FINDFUNC
  1488. '
  1489. '  INPUTS  --  PARAMETER                 MEANING
  1490. '             ACTIVE.MENU$              INDICATOR OF ACTIVE MENU
  1491. '             ADJUSTED.SECURITY         SWITCH INDICATING TEMP. SECURITY CHANGE
  1492. '             AUTODOWNLOAD.DESIRED      USER'S PREFERENCE FOR AUTODOWNLOADING
  1493. '             CALLERS.FILE$             NAME OF CALLERS FILE
  1494. '             CHAT.AVAILABLE            TOGGLE INDICATING IF SYSOP WILL CHAT
  1495. '             CHECK.BULLETIN.LOGON      USER'S PREFERENCE FOR BULLETIN CHECK
  1496. '             CONFERENCE.MODE           INDICATOR THAT USER IS IN A CONFERENCE
  1497. '             CURSOR.LINE               LINE THAT THE CURSOR IS AT
  1498. '             CURSOR.ROW                ROW THAT THE CURSOR IS AT
  1499. '             DISK.FOR.DOS$             DISK TO LOAD COMMAND.COM FROM
  1500. '             DISKFULL.GO.OFFLINE       INDICATOR OF WHAT TO DO WHEN DISK FULL
  1501. '             EXIT.TO.DOORS             FLAG INDICATING EXITING TO DOORS
  1502. '             EXPERT.USER               FLAG FOR EXPERT/NOVICE USER MODE
  1503. '             FIRST.NAME$               LOGGED ON USER'S FIRST NAME
  1504. '             F1.KEY                    FUNCTION KEY ONE VALUE
  1505. '             F10.KEY                   FUNCTION KEY TEN VALUE
  1506. '             GR                        GRAPHICS PREFERENCE OF USER
  1507. '             LINE.FEEDS                SWTICH FOR USER'S LINE FEED PREFERENCE
  1508. '             LOCAL.USER                FLAG INDICATING USER IS LOCAL
  1509. '             MINIMUM.LOGON.SECURITY    MINIMUM SECURITY TO LOGON
  1510. '             MODEM.GO.OFFHOOK.COMMAND$ COMMAND TO TAKE MODEM OFF-HOOK
  1511. '             MODEM.INIT.BAUD$          BAUD TO INITIALIZE MODEM AT
  1512. '             NODE.ID$                  NODE IDENTIFIER
  1513. '             NODE.RECORD.INDEX         NODE RECORD INDEX FOR THIS NODE
  1514. '             NULLS                     SWITCH FOR USER'S PREFERENCE FOR NULLS
  1515. '             PRINTER                   TOGGLE INDICATING PRINTER IS AVAILABLE
  1516. '             PROMPT.BELL               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1517. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION 
  1518. '             SKIP.FILES.LOGON          USER'S LOGON NOTIFICIATION PREFERENCE
  1519. '             SNOOP                     TOGGLE INDICATING SNOOP STATUS
  1520. '             SUBROUTINE.PARAMETER      -8  = SYSOP'S OPTION 6 REMOTELY
  1521. '                                       -9  = GOT TO DOS
  1522. '                                       -10 = SYSOP GET'S SYSTEM NEXT
  1523. '             SYSOP                     INDICATOR THAT USER IS SYSOP
  1524. '             SYSOP.ANNOY               TOGGLE INDICATING SYSOP IS AVAILABLE
  1525. '             SYSOP.NEXT                TOGGLE SO SYSOP GETS SYSTEM NEXT
  1526. '             UPPER.CASE                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1527. '             USER.FILE.INDEX           INDEX INTO THE USER FILE FOR CALLER
  1528. '             USER.SECURITY.LEVEL       USER'S SECURITY LEVEL
  1529. '             USERT.TRANSFER.DEFAULT    USER'S FILE TRANSFER DEFAULT PREFERENCE
  1530. '
  1531. '  OUTPUTS --
  1532. '             ADJUSTED.SECURITY        SWITCH INDICATING TEMP. SECURITY CHANGE
  1533. '             CHAT.AVAILABLE           TOGGLE INDICATING IF SYSOP WILL CHAT
  1534. '             FUNCTION.KEY             VALUE 1 TO 10 CORRESPONDING TO
  1535. '                                      THE FUNCTION KEY THAT WAS PRESSED
  1536. '             KEY.PRESSED$             CHARACTER STRING GENERATED BY KEY
  1537. '             PRINTER                  TOGGEL INDICATING PRINTER IS AVAILABLE
  1538. '             SNOOP                    TOGGLE INDICATING SNOOP STATUS
  1539. '             SYSOP                    INDICATOR THAT USER IS SYSOP
  1540. '             SYSOP.ANNOY              TOGGLE INDICATING SYSOP IS AVAILABLE
  1541. '             SYSOP.NEXT               TOGGLE SO SYSOP GETS SYSTEM NEXT
  1542. '             SUBROUTINE.PARAMETER     -1 CARRIER LOST
  1543. '                                      -2 CHAT MODE ACTIVATED
  1544. '                                      -3 FORCE CALLER ON-LINE
  1545. '                                      -4 EXIT TO SYSTEM IMMEDIATELY
  1546. '                                      -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1547. '                                      -6 TELL USER ACCESS IS DENIED
  1548. '                                      -7 UPDATE CALLERS FILE AND DENY ACCESS
  1549. '             USER.SECURITY.LEVEL      USER'S SECURITY LEVEL
  1550. '
  1551. '  PURPOSE -- To determine if a function has been pressed on
  1552. '             the PC'S keyboard that is running RBBS-PC.
  1553. '
  1554.       SUB FINDFUNC STATIC
  1555.       LOOKUP = SUBROUTINE.PARAMETER
  1556.       IF SUBROUTINE.PARAMETER < -1 THEN _
  1557.          SUBROUTINE.PARAMETER = 0 : _
  1558.          IF LOOKUP = - 8 THEN _
  1559.             GOTO 33070 _
  1560.          ELSE IF LOOKUP = - 9 THEN _
  1561.                  GOTO 31000 _
  1562.               ELSE IF LOOKUP = - 10 THEN _
  1563.                       GOTO 33090
  1564. '
  1565. '
  1566. ' *  TEST FOR FUNCTION KEY PRESSED
  1567. '
  1568. '
  1569. 30600 IF KEYBOARD.STACK$ = "" THEN _
  1570.          KEY.PRESSED$ = INKEY$ _
  1571.       ELSE KEY.PRESSED$ = KEYBOARD.STACK$ : _
  1572.            KEYBOARD.STACK$ = ""
  1573.       FUNCTION.KEY = 0
  1574.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  1575.          GOTO 33970
  1576.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  1577. '      IF LOCAL.USER AND NOT SYSOP THEN _                             ' RIP OFF
  1578. '         KEY.PRESSED$ = "" : _
  1579. '         GOTO 33970
  1580.       IF KEY.PRESSED => F1.KEY AND _
  1581.          KEY.PRESSED <= F10.KEY THEN _
  1582.              FUNCTION.KEY = KEY.PRESSED - 58 : _
  1583.              GOTO 30610
  1584.       IF KEY.PRESSED = 117 THEN _    'Ctrl-End
  1585.          FUNCTION.KEY = 11
  1586.       IF KEY.PRESSED = 73 THEN _     'PgUp
  1587.          FUNCTION.KEY = 12
  1588.       IF KEY.PRESSED = 72 THEN _     'up arrow
  1589.          FUNCTION.KEY = 13
  1590.       IF KEY.PRESSED = 80 THEN _     'Down arrow
  1591.          FUNCTION.KEY = 14
  1592.       IF KEY.PRESSED = 81 THEN _     'PgDn
  1593.          FUNCTION.KEY = 15
  1594.       IF KEY.PRESSED = 75 THEN _     'left arrow
  1595.          FUNCTION.KEY = 16
  1596.       IF KEY.PRESSED = 77 THEN _     'Right arrow
  1597.          FUNCTION.KEY = 17
  1598.       IF KEY.PRESSED = 141 THEN _    'CTRL-up arrow
  1599.          FUNCTION.KEY = 18
  1600.       IF KEY.PRESSED = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1601.          FUNCTION.KEY = 18
  1602.       IF KEY.PRESSED = 145 THEN _    'CTRL-down arrow
  1603.          FUNCTION.KEY = 19
  1604.       IF KEY.PRESSED = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1605.          FUNCTION.KEY = 19
  1606.       IF KEY.PRESSED = 115 THEN _    'CTRL-left arrow
  1607.          FUNCTION.KEY = 20
  1608.       IF KEY.PRESSED = 116 THEN _    'CTRL-right arrow
  1609.          FUNCTION.KEY = 21
  1610. 30610 KEY.PRESSED$ = ""
  1611.       IF FUNCTION.KEY < 1 OR FUNCTION.KEY > 21 THEN _
  1612.          GOTO 33970
  1613.       IF FUNCTION.KEY < 10 AND (FUNCTION.KEY <> 8) THEN _
  1614.          GOTO 30620
  1615.       IF TOGGLE.ONLY THEN _
  1616.          SUBROUTINE.PARAMETER = 1 : _
  1617.          GOTO 33970
  1618. 30620 ON FUNCTION.KEY GOTO  31000, _            '  1 =  F1
  1619.                             32000, _            '  2 =  F2
  1620.                             33000, _            '  3 =  F3
  1621.                             33040, _            '  4 =  F4
  1622.                             33060, _            '  5 =  F5
  1623.                             33070, _            '  6 =  F6
  1624.                             33090, _            '  7 =  F7
  1625.                             33110, _            '  8 =  F8
  1626.                             33130, _            '  9 =  F9
  1627.                             33150, _            ' 10 = F10
  1628.                             31398, _            ' 11 = CTRL END
  1629.                             33200, _            ' 12 = PGUP
  1630.                             33170, _            ' 13 = UP ARROW
  1631.                             33180, _            ' 14 = DOWN ARROW
  1632.                             33220, _            ' 15 = PGDN
  1633.                             33240, _            ' 16 = LEFT ARROW
  1634.                             33250, _            ' 17 = RIGHT ARROW
  1635.                             33170, _            ' 18 = CTRL-UP ARROW
  1636.                             33180, _            ' 19 = CTRL-DOWN
  1637.                             33245, _            ' 20 = CTRL-LEFT
  1638.                             33255               ' 21 = CTRL-RIGHT
  1639. '
  1640. '
  1641. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1642. '
  1643. '
  1644. 31000 SUBROUTINE.PARAMETER = -10
  1645.       CALL CARRIER
  1646.       IF SUBROUTINE.PARAMETER = 0 THEN _
  1647.          GOTO 33970
  1648.       CALL BRKFNAME(CALLERS.FILE$,X$,Y$,Z$,TRUE)
  1649.       FILE.NAME$ = X$ + "RBBS" + NODE.FILE.ID$ + "F1.DEF"
  1650.       CLOSE 2
  1651.       CALL OPENOUTW (FILE.NAME$)
  1652.       PRINT #2,MID$(FILE.NAME$,3,7)
  1653.       IF EXIT.TO.DOORS THEN _
  1654.          SUBROUTINE.PARAMETER = -4 : _
  1655.          GOTO 33970
  1656.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1657.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1658.       CALL DELAYIT (2)
  1659.       SUBROUTINE.PARAMETER = -5
  1660.       GOTO 33970
  1661. '
  1662. '
  1663. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1664. '
  1665. '
  1666. 31398 IF NOT LOCAL.USER THEN _
  1667.          CALL CARRIER : _
  1668.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1669.             GOTO 33970
  1670.       FUNCTION.KEY = 0
  1671.       IF INSTR("MUF",ACTIVE.MENU$) > 0 THEN _
  1672.          GOTO 31399
  1673.       CURSOR.LINE = CSRLIN
  1674.       CURSOR.ROW = POS(0)
  1675.       LOCATE 25,1
  1676.       D$ = SPACE$(79)
  1677.       GOSUB 33210
  1678.       LOCATE 25,1
  1679.       D$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1680.       GOSUB 33210
  1681.       CALL DELAYIT (1)
  1682.       LOCATE CURSOR.LINE,CURSOR.ROW
  1683.       SUBROUTINE.PARAMETER = 1
  1684.       CALL LINE25
  1685.       GOTO 33970
  1686. 31399 CALL QTPUT1 (FIRST.NAME$ + ", goodbye and don't call back")
  1687.       IF USER.FILE.INDEX < 1 THEN _
  1688.          SUBROUTINE.PARAMETER = -6 : _
  1689.          GOTO 33970
  1690.       USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1691.       CALL DENYACCESS
  1692.       SUBROUTINE.PARAMETER = -7
  1693.       GOTO 33970
  1694. '
  1695. '
  1696. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1697. '
  1698. '
  1699.  
  1700. 32000 IF NOT LOCAL.USER THEN _
  1701.          CALL SKIPLINE (1) : _
  1702.          CALL QTPUT1 ("Sysop exiting to DOS. Please wait...") : _
  1703.          FUNCTION.KEY = 0 : _
  1704.          CALL DELAYIT (3)
  1705.       CALL SHELLEXIT (DISK.FOR.DOS$ + "COMMAND")                     ' KG052802
  1706.       'SHELL DISK.FOR.DOS$ + _
  1707.       '      "COMMAND"
  1708.       CLS
  1709.       IF NOT LOCAL.USER THEN _
  1710.          CALL CARRIER : _
  1711.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1712.             GOTO 33970
  1713.       SUBROUTINE.PARAMETER = 2
  1714.       CALL LINE25
  1715.       CALL QTPUT1 ("Sysop back from DOS.  Returning control to you.")
  1716.       COMMPORT.STACK$ = CARRIAGE.RETURN$
  1717.       GOTO 33970
  1718. '
  1719. '
  1720. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)
  1721. '
  1722. '
  1723. 33000 PRINTER = NOT PRINTER
  1724.       CHANGE.VALUE = PRINTER
  1725.       FIELD.POSITION = 38
  1726.       GOTO 33950
  1727. '
  1728. '
  1729. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)
  1730. '
  1731. '
  1732. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  1733.       CHANGE.VALUE = SYSOP.ANNOY
  1734.       FIELD.POSITION = 34
  1735.       GOTO 33950
  1736. '
  1737. '
  1738. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1739. '
  1740. '
  1741. 33060 FUNCTION.KEY = 0
  1742.       SUBROUTINE.PARAMETER = -3
  1743.       GOTO 33970
  1744. '
  1745. '
  1746. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)
  1747. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)
  1748. '
  1749. '
  1750. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  1751.       CHANGE.VALUE = SYSOP.AVAILABLE
  1752.       FIELD.POSITION = 32
  1753.       GOTO 33950
  1754. '
  1755. '
  1756. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)
  1757. '
  1758. '
  1759. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  1760.          GOTO 33970
  1761.       SYSOP.NEXT = NOT SYSOP.NEXT
  1762.       CHANGE.VALUE = SYSOP.NEXT
  1763.       FIELD.POSITION = 36
  1764.       GOTO 33950
  1765. '
  1766. '
  1767. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)
  1768. '
  1769. '
  1770. 33110 SYSOP = NOT SYSOP
  1771.       CURSOR.LINE = CSRLIN
  1772.       CURSOR.ROW = POS(0)
  1773.       LOCATE 25,1
  1774.       D$ = SPACE$(79)
  1775.       NUM.RETURNS = 0
  1776.       CALL LPRNT (D$,NUM.RETURNS)
  1777.       LOCATE 25,1
  1778.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  1779.                             USER.SECURITY.SAVE  - _
  1780.                             SYSOP * _
  1781.                             SYSOP.SECURITY.LEVEL
  1782.       D$ = "SYSOP Privileges " + FNOFFON$(SYSOP)
  1783.       CALL LPRNT (D$,NUM.RETURNS)
  1784.       CALL DELAYIT (3)
  1785.       LOCATE CURSOR.LINE,CURSOR.ROW
  1786.       SUBROUTINE.PARAMETER = 1
  1787.       CALL LINE25
  1788.       CALL CALLOPT
  1789.       GOTO 33970
  1790. '
  1791. '
  1792. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)
  1793. '
  1794. '
  1795. 33130 IF NOT SNOOP THEN _
  1796.          SNOOP = TRUE : _
  1797.          LOCATE 24,1,0 : _
  1798.          D$ = "SNOOP ON" : _
  1799.          NUM.RETURNS = 0 : _
  1800.          CALL LPRNT (D$,NUM.RETURNS) : _
  1801.          SUBROUTINE.PARAMETER = 2 : _
  1802.          CALL LINE25 _
  1803.       ELSE LOCATE ,,0 : _
  1804.            SNOOP = FALSE : _
  1805.            CLS
  1806. 33140 CHANGE.VALUE = SNOOP
  1807.       FIELD.POSITION = 58
  1808.       GOTO 33950
  1809. '
  1810. '
  1811. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  1812. '
  1813. '
  1814. 33150 GOTO 33160
  1815. 33155 SUBROUTINE.PARAMETER = 1
  1816.       CALL LINE25
  1817.       GOTO 33970
  1818. 33160 CALL UPDTCALR ("Sysop began chat",1)
  1819.       PAGE.STATUS$ = ""
  1820.       CALL SKIPLINE (1)
  1821.       CALL QTPUT1 ("Hi " + _
  1822.            FIRST.NAME$ + _
  1823.            ", this is " + _
  1824.            SYSOP.FIRST.NAME$ + _
  1825.            " " + _
  1826.            SYSOP.LAST.NAME$ + _
  1827.            "  Sorry to break in to CHAT but..")
  1828.       CALL TIMEBACK (1)                                              ' KG082701
  1829.       CALL SYSOPCHAT
  1830.       CALL TIMEBACK (2)                                              ' KG082701
  1831.       COMMPORT.STACK$ = CHR$(13)
  1832.       GOTO 33155
  1833. '
  1834. '
  1835. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1836. '
  1837. '
  1838. 33170 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1839.                             1 - 4 * (FUNCTION.KEY = 18)
  1840.       GOTO 33190
  1841. '
  1842. '
  1843. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1844. '
  1845. '
  1846. 33180 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1847.                             1 + 4 * (FUNCTION.KEY = 19)
  1848. 33190 ADJUSTED.SECURITY = TRUE
  1849.       USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  1850.       IF (NOT CONFERENCE.MODE) AND (NOT SUB.BOARD) THEN _            ' KG052104
  1851.          ORIG.SECURITY = USER.SECURITY.LEVEL : _                     ' KG052104
  1852.       SUBROUTINE.PARAMETER = 2
  1853.       CALL LINE25
  1854.       CALL CALLOPT
  1855.       GOTO 33970
  1856. '
  1857. '
  1858. ' * PGUP DISPLAY USER PROFILE
  1859. '
  1860. '
  1861. 33200 IF NOT LOCAL.USER THEN _
  1862.          CALL CARRIER : _
  1863.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1864.             GOTO 33970
  1865.       IF VOICE.TYPE <> 0 THEN _
  1866.          TALK.ALL = TRUE
  1867.       CALL PAGEUP
  1868.       D$ = MID$("NoviceExPERT",1 -6 * EXPERT.USER,6)
  1869.       GOSUB 33210
  1870.       D$ = "GRAPHICS: " + _
  1871.            MID$("None AsciiColor",GR * 5 + 1,5)
  1872.       GOSUB 33210
  1873.       D$ = "PROTOCOL : " + _
  1874.            USER.TRANSFER.DEFAULT$
  1875.       GOSUB 33210
  1876.       D$ = "UPPER CASE " + _
  1877.            MID$("and lowerONLY", 1 - 9 * UPPER.CASE,9)
  1878.       GOSUB 33210
  1879.       D$ = "Line Feeds " + FNOFFON$(LINE.FEEDS)
  1880.       GOSUB 33210
  1881.       D$ = "Nulls " + FNOFFON$(NULLS)
  1882.       GOSUB 33210
  1883.       D$ = "Prompt Bell " + FNOFFON$(PROMPT.BELL)
  1884.       GOSUB 33210
  1885.       D$ = MID$("SKIP CHECK",1 -5 * CHECK.BULLETIN.LOGON,5) + _
  1886.            " old BULLETINS on logon."
  1887.       GOSUB 33210
  1888.       D$ = MID$("CHECKSKIP ",1 -5 * SKIP.FILES.LOGON,5) + _
  1889.            " new files on logon."
  1890.       GOSUB 33210
  1891. '      D$ = "Autodownload " + FNOFFON$(AUTODOWNLOAD.DESIRED)
  1892. '      GOSUB 33210
  1893.       TALK.ALL = FALSE
  1894.       GOTO 33970
  1895. 33210 NUM.RETURNS = 1
  1896.       CALL LPRNT(D$,NUM.RETURNS)
  1897.       RETURN
  1898. '
  1899. '
  1900. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  1901. '
  1902. '
  1903. 33220 IF NOT LOCAL.USER THEN _
  1904.          CALL CARRIER : _
  1905.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1906.             GOTO 33970
  1907.       CLS
  1908.       GOTO 33155
  1909. '
  1910. '
  1911. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1912. '
  1913. '
  1914. 33240 IF SECONDS.PER.SESSION! > 120 THEN _
  1915.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 60
  1916.       GOTO 33970
  1917. '
  1918. '
  1919. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1920. '
  1921. '
  1922. 33245 IF SECONDS.PER.SESSION! > 360 THEN _
  1923.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 300
  1924.       GOTO 33970
  1925. '
  1926. '
  1927. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1928. '
  1929. '
  1930. 33250 IF SECONDS.PER.SESSION! < 86280 THEN _
  1931.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 60
  1932.       TIME.LOCK.SET = 0
  1933.       GOTO 33970
  1934. '
  1935. '
  1936. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1937. '
  1938. '
  1939. 33255 IF SECONDS.PER.SESSION! < 86040 THEN _
  1940.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 300
  1941.       TIME.LOCK.SET = 0
  1942.       GOTO 33970
  1943. '
  1944. '
  1945. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  1946. '
  1947. '
  1948. 33950 IF SNOOP THEN _
  1949.          SUBROUTINE.PARAMETER = 1 : _
  1950.          CALL LINE25
  1951. 33960 IF CONFERENCE.MODE = TRUE THEN _
  1952.          IF LOCAL.USER THEN _
  1953.             GOTO 33970 _
  1954.          ELSE D$ = "Cannot change status during Conference!" : _
  1955.               GOSUB 33210 : _
  1956.               GOTO 33970
  1957.       SUBROUTINE.PARAMETER = 3
  1958.       CALL FILELOCK
  1959.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1960.          GOTO 33970
  1961.       CALL OPENMSG
  1962.       FIELD 1,128 AS MESSAGE.RECORD$
  1963.       GET 1,NODE.RECORD.INDEX
  1964.       MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE)
  1965.       CALL SAVEPROF (2)
  1966.       FIELD 1, 128 AS MESSAGE.RECORD$
  1967. 33970 END SUB
  1968. 33990 ' $SUBTITLE: 'PAGEUP - Display user profile to SYSOP'
  1969. ' $PAGE
  1970. '
  1971. '  NAME    -- PAGEUP
  1972. '
  1973. '  INPUTS  --     PARAMETER                    MEANING
  1974. '             ACTIVE.USER.NAME$         CURRENT USER NAME
  1975. '             DOWNLOADS                 # OF FILES DOWNLOADED
  1976. '             EXPIRATION.DATE$          REGISTRATION EXPIRATION
  1977. '             LAST.DATE.TIME.ON.SAVE$   LAST DATE & TIME ON SYSTEM
  1978. '             LAST.MESSAGE.READ         LAST MESSAGE READ BY USER
  1979. '             PASSWORD.SAVE$            USERS PASSWORD
  1980. '             TIMES.LOGGED.ON           TIMES USER HAS LOGGED ON
  1981. '             UPLOADS                   # OF FILES UPLOADED
  1982. '             USER.SECURITY.SAVE        USERS SECURITY LEVEL
  1983. '
  1984. '  OUTPUTS -- MESSAGE.RECORD$
  1985. '
  1986.       SUB PAGEUP STATIC
  1987.       CALL LPRNT (" ",1)
  1988.       CALL LPRNT ("USER NAME : " + ACTIVE.USER.NAME$,1)
  1989.       CALL LPRNT ("SECURITY  :" + STR$(USER.SECURITY.SAVE),1)
  1990.       CALL LPRNT ("PASSWORD  :" + PASSWORD.SAVE$,1)
  1991.       CALL LPRNT ("READ MSG. :" + STR$(LAST.MESSAGE.READ),1)
  1992.       CALL LPRNT ("TIMES ON  :" + STR$(TIMES.LOGGED.ON),1)
  1993.       CALL LPRNT ("LAST ON   :" + LAST.DATE.TIME.ON.SAVE$,1)
  1994.       CALL LPRNT ("DOWNLOADS :" + STR$(DOWNLOADS),1)
  1995.       CALL LPRNT ("UPLOADS   :" + STR$(UPLOADS),1)
  1996.       CALL LPRNT ("DL-BYTES  :" + STR$(DLBYTES!),1)
  1997.       CALL LPRNT ("UL-BYTES  :" + STR$(ULBYTES!),1)
  1998.       IF RESTRICT.BY.DATE THEN _
  1999.          CALL LPRNT ("EXPIRATION: " + EXPIRATION.DATE$,1)
  2000.       CALL LPRNT ("User's Profile",1)
  2001.       END SUB
  2002. 41008 ' $SUBTITLE: 'CHKTREMAIN - Kicks off if no time remaining'
  2003. ' $PAGE
  2004. '
  2005. '  NAME    -- CHKTREMAIN
  2006. '
  2007. '  INPUTS  --     PARAMETER                    MEANING
  2008. '                 TIME.LEFT!
  2009. '  OUTPUTS --     PARAMETER                    MEANING
  2010. '                 TIME.LEFT!      TIME IN MINUTES LEFT IN SESSION
  2011. '                 TCA!            TIME USED IN SECONDS
  2012. '                 SUBROUTINE.PARAMETER   -1 if no time left
  2013. '
  2014.       SUB CHKTREMAIN (TIME.LEFT!) STATIC
  2015.       CALL TIMEREMAIN (TIME.LEFT!)
  2016.       IF BYPASS.TIME.CHECK THEN _
  2017.          EXIT SUB
  2018.       IF TIME.LEFT! < 0.1 THEN _
  2019.          SUBROUTINE.PARAMETER = -1
  2020.       END SUB
  2021. 41010 ' $SUBTITLE: 'TIMEREMAIN - calculates time remaining in a session'
  2022. ' $PAGE
  2023. '
  2024. '  NAME    -- TIMEREMAIN
  2025. '
  2026. '  INPUTS  --     PARAMETER                    MEANING
  2027. '              USER.LOGON.TIME!
  2028. '              SECONDS.PER.SESSION!
  2029. '              BYPASS.TIME.CHECK
  2030. '  OUTPUTS --
  2031. '              TIME.REMAINING!       TIME IN MINUTES LEFT IN SESSION
  2032. '              TCA!                  TIME USED IN SECONDS
  2033. '
  2034.       SUB TIMEREMAIN (TIME.REMAINING!) STATIC
  2035.       TOA! = FRE("A")
  2036.       IF BYPASS.TIME.CHECK THEN _
  2037.          TIME.REMAINING! = SECONDS.PER.SESSION! /60 : _
  2038.          EXIT SUB
  2039.       CALL FINDTIME (TI!)
  2040.       ROLLOVER = FALSE
  2041.       IF TI! > USER.LOGON.TIME! THEN _
  2042.          TCA! = TI! - USER.LOGON.TIME! : _
  2043.          GOTO 41020
  2044.       ROLLOVER = TRUE
  2045.       TCA! = TI! + 86400! - USER.LOGON.TIME!
  2046. 41020 IF TIME.TO.DROP.TO.DOS! = 0 OR _
  2047.          OLD.DAT$ = DATE$ THEN _
  2048.          GOTO 41030
  2049.       IF NOT ROLLOVER AND _
  2050.          USER.LOGON.TIME! + SECONDS.PER.SESSION! => TIME.TO.DROP.TO.DOS! THEN _
  2051.          SECONDS.PER.SESSION! = (TIME.TO.DROP.TO.DOS! - USER.LOGON.TIME!) : _
  2052.          SHORTENED = TRUE
  2053.       IF ROLLOVER AND _
  2054.          USER.LOGON.TIME! + SECONDS.PER.SESSION! - 86400 => TIME.TO.DROP.TO.DOS! THEN _
  2055.          SECONDS.PER.SESSION! = TIME.TO.DROP.TO.DOS! : _
  2056.          SHORTENED = TRUE
  2057.       IF SHORTENED AND NOT TOLD.SHORT THEN _
  2058.          TOLD.SHORT = TRUE : _
  2059.          A$ = "Time shortened for scheduled event" : _
  2060.          CALL RINGCALLER
  2061. 41030 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
  2062.       TIME.REMAINING! = -(TIME.REMAINING! > 0.0)*TIME.REMAINING!
  2063.       END SUB
  2064. 41032 ' $SUBTITLE: 'DISPLAYTR - Display users time remaining'
  2065. ' $PAGE
  2066. '
  2067. '  NAME    -- DISPLAYTR
  2068. '
  2069. '  INPUTS  --     PARAMETER                    MEANING
  2070. '              TIME.REMAINING!
  2071. '
  2072. '  OUTPUTS --     PARAMETER                    MEANING
  2073. '              TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2074. '
  2075.       SUB DISPLAYTR (TIME.REMAINING!) STATIC
  2076.       CALL TIMEREMAIN (TIME.REMAINING!)
  2077.       CALL QTPUT1 (STR$(INT(TIME.REMAINING!)) + " min left")
  2078.       END SUB
  2079. 41498 ' $SUBTITLE: 'AMORPMTD - give time of day in AM/PM format'
  2080. ' $PAGE
  2081. '
  2082. '  NAME    -- AMORPMTD
  2083. '
  2084. '  INPUTS  --     PARAMETER                    MEANING
  2085. '
  2086. '  OUTPUTS -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  2087. '             TIM$                    CURRENT TIME (I.E. 1:13 PM)
  2088. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  2089. '
  2090. '  PURPOSE -- To set the time and date and
  2091. '             describe the time as "AM" or "PM."
  2092. '
  2093.       SUB AMORPMTD STATIC                                            ' KG061203
  2094. '
  2095. '
  2096. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2097. '
  2098. '
  2099. 41500 TIME.LOGGED.ON$ = TIME$
  2100.       CURRENT.DATE$ = DATE$
  2101.       CURRENT.DATE$ = LEFT$(CURRENT.DATE$ ,6) + _
  2102.                       RIGHT$(CURRENT.DATE$ ,2)
  2103.       CALL AMORPM                                                    ' KG061203
  2104.       END SUB
  2105.       SUB AMORPM STATIC                                              ' KG061203
  2106. 41510 TIM$ = TIME$
  2107.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  2108.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  2109.          TIM$ = LEFT$(TIM$,5) + _
  2110.                 " PM" : _
  2111.          EXIT SUB
  2112.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  2113.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  2114.          TIM$ = LEFT$(TIM$,5) + _
  2115.                 " PM" : _
  2116.          EXIT SUB
  2117.       TIM$ = LEFT$(TIM$,5) + _
  2118.              " AM"
  2119.       END SUB                                                        ' KG061203
  2120. 42000 ' $SUBTITLE: 'CARRIER - sub to monitor carrier on comm. port'
  2121. ' $PAGE
  2122. '
  2123. '  NAME    -- CARRIER
  2124. '
  2125. '  INPUTS  --     PARAMETER                    MEANING
  2126. '              AUTO.LOGOFF                  -1 if in autologoff request
  2127. '
  2128. '  OUTPUTS --  SUBROUTINE.PARAMETER = 0     CONTINUE
  2129. '              SUBROUTINE.PARAMETER = -1    TERMINATE (NO CARRIER)
  2130. '
  2131. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  2132. '              NOT to continue are:  autologoff, out of time, or
  2133. '              carrier dropped.
  2134. '
  2135.       SUB CARRIER STATIC
  2136.       IF AUTO.LOGOFF THEN _                                          ' KG061203
  2137.          SUBROUTINE.PARAMETER = -1 : _                               ' KG061203
  2138.          EXIT SUB                                                    ' KG061203
  2139.       CALL CHKCARRIER                                                ' KG061203
  2140.       END SUB                                                        ' KG061203
  2141. 42005 ' $SUBTITLE: 'CHKCARRIER - monitors carrier on comm. port'     ' KG080501
  2142. ' $PAGE
  2143. '
  2144. '  NAME    -- CHKCARRIER
  2145. '
  2146. '  INPUTS  --     PARAMETER                    MEANING
  2147. '              LOCAL.USER = 0               REMOTE USER
  2148. '              LOCAL.USER = -1              LOCAL KEYBOARD USER
  2149. '              MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  2150. '                                           CATIONS PORT'S REGISTER
  2151. '              SUBROUTINE.PARAMETER = -9    DON'T WRITE TO CALLERS
  2152. '              SUBROUTINE.PARAMETER = -10   SAME AS -9, BUT DON'T
  2153. '                                           DELAY
  2154. '
  2155. '  OUTPUTS --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  2156. '              SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  2157. '
  2158. '  PURPOSE --  To test if carrier is present (i.e. the user
  2159. '              is still on line).  Ignores whether in autologoff.
  2160. '
  2161.       SUB CHKCARRIER STATIC                                          ' KG061203
  2162.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2163.          EXIT SUB
  2164.       SPEEDY = SUBROUTINE.PARAMETER
  2165.       SUBROUTINE.PARAMETER = 0
  2166. '
  2167. '
  2168. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)
  2169. '
  2170. '
  2171.       IF LOCAL.USER THEN _
  2172.          EXIT SUB
  2173.       IF FOSSIL THEN _
  2174.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2175.          STATUS% = STATUS% AND &H0080 : _
  2176.          IF STATUS% = &H0080 THEN _
  2177.             EXIT SUB _
  2178.          ELSE GOTO 42015
  2179. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2180.          EXIT SUB
  2181. '
  2182. '
  2183. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER
  2184. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,
  2185. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2186. '
  2187. '
  2188. 42015 IF SPEEDY = -10 THEN _
  2189.          GOTO 42020
  2190.       CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  2191.       IF FOSSIL THEN _
  2192.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2193.          STATUS% = STATUS% AND &H0080 : _
  2194.          IF STATUS% = &H0080 THEN _
  2195.             EXIT SUB
  2196.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2197.          EXIT SUB
  2198. 42020 SUBROUTINE.PARAMETER = -1
  2199.       IF SPEEDY < -8 THEN _
  2200.          EXIT SUB
  2201.       IF ALREADY.WRITTEN = -9 THEN _
  2202.          EXIT SUB
  2203.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2204.       CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2205.       MODEM.OFFHOOK = -1
  2206.       ALREADY.WRITTEN = -9
  2207. ' Pe 03/22/89  Auto Log off fix
  2208. IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  2209.       CALL UPDTCALR (" Used Auto Logg Off ",1) _
  2210. ELSE _
  2211.       CALL UPDTCALR ("Carrier dropped",1)
  2212.       END SUB
  2213. 43004 ' $SUBTITLE: 'ASKGRAPH -- sub to ask users graphic preference'
  2214. ' $PAGE
  2215. '
  2216. '  NAME    -- ASKGRAPH
  2217. '
  2218. '  INPUTS  --    PARAMETER                    MEANING
  2219. '                UGD$                         USER GRAPHIC DEFAULT
  2220. '
  2221. '  OUTPUTS --
  2222. '
  2223. '  PURPOSE --  To determine users graphics default
  2224. '
  2225.       SUB ASKGRAPH (UGD$) STATIC
  2226.       IF EXPERT.USER THEN _
  2227.          GOTO 43007
  2228. 43006 FILE.NAME$ = HELP$(9)
  2229.       CALL BUFFILE (FILE.NAME$,X)
  2230.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2231.          EXIT SUB
  2232. 43007 CALL QTPUT1 ("GRAPHICS for text files and menus")
  2233.       A$ = "Change from " + MID$("NAC",GR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + PRESS.ENTER.EXPERT$
  2234.       SUBROUTINE.PARAMETER = 1
  2235.       TURBO.KEY = -TURBO.KEY.USER
  2236.       CALL TGET
  2237.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2238.          EXIT SUB
  2239.       IF Q = 0 THEN _
  2240.          CALL QTPUT1 ("Unchanged") : _
  2241.          EXIT SUB
  2242.       CALL ALLCAPS (B$(1))
  2243.       GR = INSTR("NAC",B$(1))
  2244.       IF GR = 2 AND NOT EIGHT.BIT THEN _
  2245.          CALL QTPUT1 ("Ascii unavailable.  Requires 8 bit") : _
  2246.          GOTO 43007
  2247.       IF GR = 0 THEN _
  2248.          GOTO 43006
  2249.       GR = GR - 1
  2250.       CALL SETUGD (GR,UGD$)
  2251.       CALL GETCOLOR          'Pe color mods
  2252.       END SUB
  2253. '
  2254. 43031 ' $SUBTITLE: 'GRAPHIC - sub to find graphic version of a file'
  2255. ' $PAGE
  2256. '
  2257. '  NAME    -- GRAPHIC
  2258. '
  2259. '  INPUTS  --     PARAMETER                    MEANING
  2260. '                 DEFAULT$          USERS GRAPHIC DEFAULT
  2261. '                 GR                WHETHER GRAPHICS ARE AVAILABLE
  2262. '                 FILNAME$          FILE TO CHECK
  2263. '
  2264. '  OUTPUTS --     FILNAME$          SUBSTITUTES NAME OF GRAPHICS
  2265. '                                   FILE (IF IT EXISTS).
  2266. '
  2267. '  PURPOSE -- Checks whether there is a graphics version of
  2268. '             a file, based on users graphics perference.
  2269. '             Sets file name to graphcis file if it exists,
  2270. '             Otherwise leaves file name intact.  Returns file
  2271. '             name to use.
  2272. '
  2273.       SUB GRAPHICX (DEFAULT$,FILNAME$,FILNUM) STATIC                 ' KG061001
  2274.       OK = FALSE
  2275.       IF GR THEN _
  2276.          CALL BRKFNAME (FILNAME$,DR$,X$,EXTENTION$,TRUE) : _
  2277.          IF LEN(X$) < 8 THEN _
  2278.             DF$ = DR$ + _
  2279.                   X$ + _
  2280.                   DEFAULT$ + _
  2281.                   EXTENTION$ : _
  2282.              CALL FINDITX (DF$,FILNUM) : _                           ' KG061001
  2283.              IF OK THEN _
  2284.                 FILNAME$ = DF$ : _
  2285.                 IF DEFAULT$ = "C" THEN _
  2286.                    LINES.PRINTED = 0
  2287.       IF NOT OK THEN _
  2288.          CALL FINDITX (FILNAME$,FILNUM)                              ' KG061001
  2289.       END SUB
  2290.       SUB GRAPHIC (DEFAULT$,FILNAME$) STATIC                         ' KG061001
  2291.       CALL GRAPHICX (DEFAULT$,FILNAME$,2)                            ' KG061001
  2292.       END SUB
  2293. 43068 ' $SUBTITLE: 'SAVEPROF - subroutine to read a user profile'
  2294. ' $PAGE
  2295. '
  2296. '  NAME    -- SAVEPROF
  2297. '
  2298. '  INPUTS  --     PARAMETER                    MEANING
  2299. '              BPS
  2300. '              EIGHT.BIT
  2301. '              EXIT.TO.DOORS
  2302. '              GR
  2303. '              MESSAGE.RECORD$
  2304. '              NODE.RECORD.INDEX
  2305. '              SYSOP
  2306. '              UPPER.CASE
  2307. '              TIME.LOGGED.ON$
  2308. '              PRIVATE.DOOR
  2309. '              RELIABLE.MODE
  2310. '
  2311. '  OUTPUTS -- NONE
  2312. '
  2313. '  PURPOSE -- Saves a user's options and communications parameters
  2314. '             in the node record when a user exits to a "door" so
  2315. '             that he is in the same status as when he exited.
  2316. '
  2317.       SUB SAVEPROF(IPARM) STATIC
  2318.       ON IPARM GOTO 43070,43080                                      ' KG072501
  2319. 43070 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2320.       SUBROUTINE.PARAMETER = 3
  2321.       CALL FILELOCK
  2322.       CALL OPENMSG
  2323.       FIELD 1, 128 AS MESSAGE.RECORD$
  2324.       GET 1,NODE.RECORD.INDEX
  2325.       IF GLOBAL.SYSOP THEN _
  2326.          MID$(MESSAGE.RECORD$,1,30) = "SYSOP" + SPACE$(25)
  2327.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  2328.       MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
  2329.       MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
  2330.       MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
  2331.       MID$(MESSAGE.RECORD$,48,5) = MKS$(NUM.DWN.BYTS!) + MID$(STR$(-BATCH.TRANSFER),2)
  2332.       MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
  2333.       MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
  2334.       MID$(MESSAGE.RECORD$,65,3) = CHR$(VAL(LEFT$(TIME.LOGGED.ON$,2))) + _
  2335.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,4,2))) + _
  2336.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,7,2)))
  2337.       MID$(MESSAGE.RECORD$,72,2) = STR$(PRIVATE.DOOR)
  2338.       MID$(MESSAGE.RECORD$,74,1) = MID$(STR$(TRANSFER.FUNCTION),2,1)
  2339.       MID$(MESSAGE.RECORD$,75,1) = FT$
  2340.       MID$(MESSAGE.RECORD$,113,2) = MKI$(CINT(TIME.CREDITS!)/60)     ' RH080201
  2341.       MID$(MESSAGE.RECORD$,79,8) = LEFT$(DOORED.TO$+"        ",8)
  2342.       MID$(MESSAGE.RECORD$,91,2) = STR$(RELIABLE.MODE)
  2343.       CALL BRKFNAME (CURRENT.PUI$,A$,B$,Z$,FALSE)
  2344.       MID$(MESSAGE.RECORD$,93,8) = B$ + SPACE$(8 - LEN(B$))
  2345.       MID$(MESSAGE.RECORD$,101,2) = STR$(LOCAL.USER)
  2346.       MID$(MESSAGE.RECORD$,103,2) = STR$(LOCAL.USER.MODE)
  2347.       GRN$ = LEFT$(GRN$,INSTR(GRN$ + " "," ") - 1)
  2348.       MID$(MESSAGE.RECORD$,105,8) = GRN$ + SPACE$(8 - LEN(GRN$))
  2349.       MID$(MESSAGE.RECORD$,115,1) = MID$(STR$(AUTO.LOGOFF),2,1)      ' DA083002
  2350.       MID$(MESSAGE.RECORD$,117,2) = STR$(MENU.INDEX)
  2351.       MID$(MESSAGE.RECORD$,119,2) = LEFT$(DATE$,2)
  2352.       MID$(MESSAGE.RECORD$,121,2) = MID$(DATE$,4,2)
  2353.       MID$(MESSAGE.RECORD$,123,2) = RIGHT$(DATE$,2)
  2354.       MID$(MESSAGE.RECORD$,125,2) = LEFT$(TIME$,2)
  2355.       MID$(MESSAGE.RECORD$,127,2) = MID$(TIME$,4,2)
  2356. 43080 PUT 1,NODE.RECORD.INDEX
  2357.       SUBROUTINE.PARAMETER = 2
  2358.       CALL FILELOCK
  2359.       CALL OPENMSG
  2360.       END SUB
  2361. 44000 ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  2362. ' $PAGE
  2363. '
  2364. '  NAME    -- READPROF
  2365. '
  2366. '  INPUTS  --     PARAMETER                    MEANING
  2367. '              NODE.RECORD.INDEX     NODE RECORD TO USE
  2368. '              SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  2369. '              SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  2370. '
  2371. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2372. '             UPON EXITING RBBS-PC TO A "DOOR"
  2373. '
  2374. '  PURPOSE -- Reset a user's options and communications parameters
  2375. '             that were saved in the node record when a user exited
  2376. '             to a "door" so that he is in the same status as when
  2377. '             he exited.
  2378. '
  2379.       SUB READPROF STATIC                                            ' KG072501
  2380.       LOCATE 24,1
  2381.       CALL LPRNT("NODE INDEX" + STR$(NODE.RECORD.INDEX),1)
  2382.       FIELD 1, 128 AS MESSAGE.RECORD$
  2383.       GET 1,NODE.RECORD.INDEX
  2384.       RELIABLE.MODE = VAL(MID$(MESSAGE.RECORD$,91,2))
  2385.       MID$(MESSAGE.RECORD$,40,2) = "00"
  2386.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  2387.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  2388.       CALL COMMINFO
  2389.       BAUD.TEST! = VAL(MID$("      300  450 1200 2400 4800 96001920038400",(-5 * BPS),5)) ' KG090102
  2390.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  2391.       NUM.DWN.BYTS! = CVS(MID$(MESSAGE.RECORD$,48,4))
  2392.       BATCH.TRANSFER = (MID$(MESSAGE.RECORD$,52,1) = "1")
  2393.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  2394.       HOUR.LOGGED.ON$ = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,65,1))),2),2)  ' KP061804
  2395.       MIN.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,66,1))),2),2)  ' KP061804
  2396.       SEC.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,67,1))),2),2)  ' KP061804
  2397.       TIME.LOGGED.ON$ = HOUR.LOGGED.ON$ + _                                          ' KP061804
  2398.                         ":" + _                                                      ' KP061804
  2399.                         MIN.LOGGED.ON$ + _                                           ' KP061804
  2400.                         ":" + _                                                      ' KP061804
  2401.                         SEC.LOGGED.ON$                                               ' KP061804
  2402.       TRANSFER.FUNCTION = VAL(MID$(MESSAGE.RECORD$,74,1))
  2403.       FT$ = MID$(MESSAGE.RECORD$,75,1)
  2404.       TIME.CREDITS! = 60*CVI(MID$(MESSAGE.RECORD$,113,2))            ' RH080201
  2405.       DOORED.TO$ = MID$(MESSAGE.RECORD$,79,8)
  2406.       CALL TRIM (DOORED.TO$)
  2407.       IF EXIT.TO.DOORS AND DOORED.TO$ <> "" THEN _
  2408.          CALL OPENWORK (2,DOORS.DEF$) : _
  2409.          IF EC = 0 THEN _
  2410.             CALL READPARMS (A$(),8,1) : _
  2411.             WHILE EC = 0 AND A$(1) <> DOORED.TO$ : _
  2412.                CALL READPARMS (A$(),8,1) : _
  2413.             WEND : _
  2414.             IF A$(1) = DOORED.TO$ THEN _
  2415.                DOOR.SKIPS.PASSWORD = TRUE : _
  2416.                CALL BUFFILE (A$(7),X)
  2417.       EC = 0
  2418.       MENU.INDEX = VAL(MID$(MESSAGE.RECORD$,117,2))
  2419.       CURRENT.PUI$ = MID$(MESSAGE.RECORD$,93,8)
  2420.       CALL REMOVE (CURRENT.PUI$," ")
  2421.       IF CURRENT.PUI$ <> "" THEN _
  2422.          CALL BRKFNAME (MAIN.PUI$,A$,B$,Z$,TRUE) : _
  2423.          CURRENT.PUI$ = A$ + CURRENT.PUI$ + Z$
  2424.       CUSTOM.PUI = (CURRENT.PUI$ <> "")
  2425.       LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
  2426.       LOCAL.USER.MODE = VAL(MID$(MESSAGE.RECORD$,103,2))
  2427.       HOME.CONFERENCE$ = MID$(MESSAGE.RECORD$,105,8)
  2428.       AUTO.LOGOFF = (VAL(MID$(MESSAGE.RECORD$,115,1)) <> 0)          ' DA083002
  2429.       CALL TRIM (HOME.CONFERENCE$)
  2430.       IF REQUIRED.RINGS > 0 AND _
  2431.          INSTR(MODEM.INIT.COMMAND$,"S0=255") THEN _
  2432.          COLOR 7,0,0 _
  2433.       ELSE COLOR FG,BG,BORDER
  2434.       IF LOCAL.USER.MODE THEN _
  2435.          GOTO 44003
  2436.       CALL SETBAUD
  2437. 44003 USER.LOGON.TIME! = VAL(HOUR.LOGGED.ON$) * 3600 + _             ' KP061804
  2438.                          VAL(MIN.LOGGED.ON$) * 60 + _                ' KP061804
  2439.                          VAL(SEC.LOGGED.ON$)                         ' KP061804
  2440.       HOUR.LOGGED.ON$ = ""                                           ' KP061804
  2441.       MIN.LOGGED.ON$ = ""                                            ' KP061804
  2442.       SEC.LOGGED.ON$ = ""                                            ' KP061804
  2443.       IF MINUTES.PER.SESSION! < 1 THEN _
  2444.          MINUTES.PER.SESSION! = 3
  2445.       IF NOT EIGHT.BIT THEN _
  2446.          OUT LINE.CONTROL.REGISTER,&H1A
  2447.       IF LEFT$(MESSAGE.RECORD$,7) = "SYSOP  " THEN _
  2448.          ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2449.       ELSE FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ") : _
  2450.            LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$ + " ","  ") : _
  2451.            FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1) : _
  2452.            LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END - (FIRST.NAME.END + 1)) : _
  2453.            ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  2454.       Z$ = FIRST.NAME$
  2455.       END SUB
  2456. 44020 ' $SUBTITLE: 'COMMINFO - sub for variable of users baud/parity'
  2457. ' $PAGE
  2458. '
  2459. '  NAME    -- COMMINFO
  2460. '
  2461. '  INPUTS  --     PARAMETER                    MEANING
  2462. '                 BPS               BAUD RATE INDICATOR
  2463. '                 EIGHT.BIT           INDICATE FOR N/8/1
  2464. '
  2465. '  OUTPUTS -- BAUD.PARITY$
  2466. '
  2467. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2468. '
  2469.       SUB COMMINFO STATIC
  2470. '
  2471. '
  2472. ' *  DETERMINE BAUD AND PARITY
  2473. '
  2474. '
  2475.   IF RELIABLE.MODE THEN _
  2476.      RELIABLE.MODE$ = "-R," _
  2477.   ELSE RELIABLE.MODE$ = ","
  2478.   BAUD.PARITY$ = MID$("      300  450 1200 2400 4800 96001920038400",(-5 * BPS),5) + _ ' KG090201
  2479.                  " BAUD" + _
  2480.                  RELIABLE.MODE$ + _
  2481.                  MID$("N,8,1E,7,1",6 + 5 * EIGHT.BIT,5)
  2482.   BAUD.TEST! = VAL(BAUD.PARITY$)                                     ' KG090102
  2483.   END SUB
  2484. 50495 ' $SUBTITLE: 'DELAYIT - sub to wait number of seconds specified'
  2485. ' $PAGE
  2486. '
  2487. '  NAME    -- DELAYIT
  2488. '
  2489. '  INPUTS  --     PARAMETER                    MEANING
  2490. '                 DELAY.TIME           NUMBER OF SECONDS TO DELAY
  2491. '                                      (0 TO 3,600)
  2492. '
  2493. '  OUTPUTS -- NONE
  2494. '
  2495. '  PURPOSE -- To wait the number of seconds indicated before
  2496. '             returning control to the calling routine.
  2497. '
  2498.       SUB DELAYIT (DELAY.TIME) STATIC
  2499.       IF DELAY.TIME < 1 THEN _
  2500.          EXIT SUB
  2501.       CALL FINDTIME (DELAY!)
  2502.       DELAY! = DELAY.TIME + DELAY!
  2503.       IF DELAY! < 86400! THEN _
  2504.          GOTO 50520
  2505. 50500 CALL FINDTIME (TI!)
  2506.       IF TI! > DELAY.TIME THEN _  ' IF SECONDS TO DELAY IS PAST
  2507.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  2508.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  2509. 50520 CALL FINDTIME (TI!)
  2510.       IF TI! < DELAY! THEN _
  2511.          GOTO 50520
  2512.       END SUB
  2513. 52070 ' $SUBTITLE: 'MODEMPUT - sub to write modem commands to modem'
  2514. ' $PAGE
  2515. '
  2516. '  SUBROUTINE NAME    -- MODEMPUT
  2517. '
  2518. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2519. '                        STRNG$                    MODEM COMMAND
  2520. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  2521. '                                                  MODEM TO STOP RINGING
  2522. '                                                  BEFORE ISSUING COMMANDS
  2523. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  2524. '                                                  NOT UNDERSTAND COMMANDS
  2525. '
  2526. '  OUTPUT PARAMETERS  -- NONE
  2527. '
  2528. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2529. '
  2530.       SUB MODEMPUT (STRNG$) STATIC
  2531. '
  2532. '
  2533. ' *  SEND MODEM COMMAND
  2534. '
  2535. '
  2536.       IF DUMB.MODEM THEN _
  2537.          EXIT SUB
  2538.       IF NOT COMMANDS.BETWEEN.RINGS OR _
  2539.          NOT (INP(MODEM.STATUS.REGISTER) AND &H40) THEN _
  2540.          GOTO 52080
  2541.       CALL SETABORT (CONNECT.DELAY!,7)
  2542. 52072 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 THEN _
  2543.          CALL FINDTIME (TI!) : _
  2544.          IF TI! > CONNECT.DELAY! OR _
  2545.             (ABS(CONNECT.DELAY! - TI!) > 30 AND _
  2546.              (TI! + 86400 > CONNECT.DELAY!)) THEN _
  2547.             GOTO 52080
  2548.       GOTO 52072
  2549. 52080 CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2550.       CALL COMMPUT (STRNG$)
  2551.       END SUB
  2552. 57001 ' $SUBTITLE: 'DISPCALL - subroutine to display callers file'
  2553. ' $PAGE
  2554. '
  2555. '  NAME    -- DISPCALL
  2556. '
  2557. '  INPUTS  --     PARAMETER           MEANING
  2558. '
  2559. '  OUTPUTS --  (NONE)
  2560. '
  2561. '  PURPOSE -- Displays callers file to sysops and callers
  2562. '
  2563.       SUB DISPCALL STATIC
  2564.       IF CALLERS.FILE.PREFIX$ = "" THEN _
  2565.          EXIT SUB
  2566.       CALL SKIPLINE (1)
  2567.       CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX!
  2568.       CLOSE 4
  2569.       IF SHARE.IT THEN _
  2570.          OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _
  2571.       ELSE OPEN "R",4,CALLERS.FILE$,64
  2572.       FIELD 4,64 AS CALLERS.RECORD$
  2573. 57005 IF CALLERS.FILE.INDEX.TEMP! < 1 OR RET THEN _
  2574.          EXIT SUB
  2575. 57010 GET 4,CALLERS.FILE.INDEX.TEMP!
  2576.       A$ = CALLERS.RECORD$
  2577.       IF LEFT$(A$,3) = "   " OR _
  2578.          INSTR(A$,"on at") = 0 THEN _
  2579.          GOTO 57030
  2580. 57025 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! - 1
  2581.       GET 4,CALLERS.FILE.INDEX.TEMP!
  2582.       Z = INSTR(CALLERS.RECORD$,"{")
  2583.       IF Z < 1 OR Z > 15 THEN _
  2584.          Z = 15
  2585.       IF SYSOP OR _
  2586.          LEFT$(A$,3) <> "   " THEN _
  2587.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z - 1)
  2588.       GOSUB 57100
  2589.       IF SYSOP THEN _
  2590.          A$ = MID$(CALLERS.RECORD$,Z) : _
  2591.          GOSUB 57100
  2592.       GOTO 57045
  2593. 57030 IF SYSOP THEN _
  2594.          GOSUB 57100
  2595. 57045 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! -1
  2596.       GOTO 57005
  2597. 57100 IF INSTR(A$,"LOGON DENIED") THEN _
  2598.          IF NOT SYSOP THEN _
  2599.             RETURN
  2600.       CALL QTPUT1 (A$)
  2601.       CALL ASKMORE ("",TRUE,TRUE,X,FALSE)
  2602.       IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
  2603.          EXIT SUB
  2604.       RETURN
  2605.       END SUB
  2606. 58050 ' $SUBTITLE: 'FINDTIME - sub to calculate seconds since midnight'
  2607. ' $PAGE
  2608. '
  2609. '  NAME    -- FINDTIME
  2610. '
  2611. '  INPUTS  --     PARAMETER           MEANING
  2612. '               SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2613. '
  2614. '  OUTPUTS --     SECONDS!          SECONDS SINCE MIDNIGHT
  2615. '
  2616. '  PURPOSE -- To calculate the number of seconds that elapsed since midnight
  2617. '
  2618.       SUB FINDTIME (SECONDS!) STATIC
  2619.       SECONDS! = TIMER
  2620.       END SUB
  2621. 58060 ' $SUBTITLE: 'ALLCAPS - sub to convert string to upper case'
  2622. ' $PAGE
  2623. '
  2624. '  NAME    -- ALLCAPS
  2625. '
  2626. '  INPUTS  --     PARAMETER           MEANING
  2627. '              CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2628. '
  2629. '  OUTPUTS --  CONVERT.FIELD$    CONVERTED STRINGS
  2630. '
  2631. '  PURPOSE -- Subroutine to convert a string to upper case
  2632. '
  2633.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2634.       IF TURBO.RBBS THEN _
  2635.          CALL RBBSULC (CONVERT.FIELD$) : _
  2636.          EXIT SUB
  2637.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2638.          IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2639.             MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2640.       NEXT
  2641.       END SUB
  2642. 58070 ' $SUBTITLE: 'CHECKTIM - sub to see if time has elasped'
  2643. ' $PAGE
  2644. '
  2645. '  NAME    -- CHECKTIM
  2646. '
  2647. '  INPUTS  --     PARAMETER           MEANING
  2648. '                 MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2649. '                                              NOT TO EXCEED
  2650. '
  2651. '  OUTPUTS -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2652. '                                      MAX.TIME!
  2653. '             SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2654. '                                                 OR EQUAL TO MAX.TIME!
  2655. '
  2656. '  PURPOSE -- Subroutine to check if the current time is greater
  2657. '             than or equal to the time allowed
  2658. '
  2659.       SUB CHECKTIM (MAX.TIME!) STATIC
  2660.       SUBROUTINE.PARAMETER = 1
  2661.       CALL FINDTIME (TI!)
  2662.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2663.          EXIT SUB
  2664.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2665.          SUBROUTINE.PARAMETER = 2 : _
  2666.          EXIT SUB
  2667.       TEST.TIME! = MAX.TIME! - 86400
  2668.       IF TEST.TIME! - TI! <= 0 THEN _
  2669.          EXIT SUB
  2670.       IF TI! => TEST.TIME! THEN _
  2671.          SUBROUTINE.PARAMETER = 2
  2672.       END SUB
  2673. 58080 ' $SUBTITLE: 'HASHRBBS - sub to determine where to look for user'
  2674. ' $PAGE
  2675. '
  2676. '  NAME    -- HASHRBBS
  2677. '
  2678. '  INPUTS  --     PARAMETER           MEANING
  2679. '               STRNG.TO.HASH$    USER NAME TO LOCATE
  2680. '               MAX.POSITION      MAXIMUM # USERS
  2681. '
  2682. '  OUTPUTS --     PRIME.HASH        WHERE TO LOOK FIRST
  2683. '                SECOND.HASH       LOOK THIS FAR AHEAD
  2684. '
  2685. '  PURPOSE -- Where to look for a user in users file
  2686. '             Look first at prime position, then add
  2687. '             SECOND.HASH until find or find unused record
  2688. '
  2689.       SUB HASHRBBS (STRNG.TO.HASH$,MAX.POSITION,PRIME.HASH,SECOND.HASH) STATIC
  2690.       SECOND.HASH = (ASC(MID$(STRNG.TO.HASH$,2,1)) * 10  + 7) MOD _
  2691.            MAX.POSITION
  2692.       PRIME.HASH = _
  2693.            ((ASC(STRNG.TO.HASH$) * 100  + _
  2694.              ASC(MID$(STRNG.TO.HASH$,(LEN(STRNG.TO.HASH$) / 2) + .1,1)) * _
  2695.              10  + _
  2696.              ASC(RIGHT$(STRNG.TO.HASH$,1))) _
  2697.              MOD MAX.POSITION) + 1
  2698.       END SUB
  2699. 58100 ' $SUBTITLE: 'SETOPTS - sub to set prompts based on user security'
  2700. ' $PAGE
  2701. '
  2702. '  NAME    -- SETOPTS
  2703. '
  2704. '  INPUTS  --     PARAMETER           MEANING
  2705. '                   FIRST             POSITION WHERE START LOOKING
  2706. '                   LAST              POSITION WHERE QUIT LOOKING
  2707. '                 USER.SECURITY.LEVEL SECURITY OF USER
  2708. '
  2709. '  OUTPUTS -- OPTIONS$              LIST OF COMMANDS USER CAN DO
  2710. '
  2711. '  PURPOSE -- String together what commands user can do in a section
  2712. '
  2713.       SUB SETOPTS (OPTIONS$,INVALID.OPTIONS$,FIRST,LAST) STATIC
  2714.       OPTIONS$ = ""
  2715.       INVALID.OPTIONS$ = ""
  2716.       FOR I = FIRST TO LAST
  2717.          IF USER.SECURITY.LEVEL < OPT.SEC(I) THEN _
  2718.             INVALID.OPTIONS$ = INVALID.OPTIONS$ + _
  2719.                                MID$(ALL.OPTS$,I,1) _
  2720.          ELSE IF MID$(ALL.OPTS$,I,1) <> " " THEN _
  2721.                  OPTIONS$ = OPTIONS$ + _
  2722.                             MID$(ALL.OPTS$,I,1)
  2723.       NEXT
  2724.       CALL SRTSTRNG (OPTIONS$)
  2725.       CALL SRTSTRNG (INVALID.OPTIONS$)
  2726.       END SUB
  2727. 58110 ' $SUBTITLE: 'CHKNEWBUL - sub to check whether got new bulletins'
  2728. ' $PAGE
  2729. '
  2730. '  NAME    -- CHKNEWBUL
  2731. '
  2732. '  INPUTS  --     PARAMETER           MEANING
  2733. '                 LAST.ON$          LAST DATE OF LOGON
  2734. '                                   FORMAT MM/DD/YY
  2735. '                 ACTIVE.BULLETINS  # OF BULLETING
  2736. '                 BULLETIN.PREFIX$  FILESPEC FOR BULLETINS
  2737. '
  2738. '  OUTPUTS --     NUM.NEW.BULLETS   NUMBER OF NEW BULLETINS
  2739. '                 NEW.BULLETS$      LIST OF NEW BULLET #'S
  2740. '                 Q                 WHERE LAST BULLETIN STORED
  2741. '                                      IN B$()
  2742. '                 B$()              BULLETINS #'S THAT ARE NEW
  2743. '                                      (2,3,4,...)
  2744. '
  2745. '  PURPOSE -- Checks how many bulletins have system date
  2746. '             at or later than date caller last logged on
  2747. '
  2748.       SUB CHKNEWBUL (LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$) STATIC
  2749.       NUM.NEW.BULLETS = 0
  2750.       NEW.BULLETS$ = ":  "
  2751.       BASE.DATE# = VAL(MID$(LAST.ON$,4,2)) + (100 * VAL(MID$(LAST.ON$,1,2))) + _
  2752.                    (10000# * (1900 + VAL(MID$(LAST.ON$,7,2))))
  2753.       CALL FINDIT (BULLETIN.PREFIX$ + ".FCK")
  2754. '      X = 0
  2755. '      CALL QTPUT ("Checking new bulletins",0)
  2756.       IF OK THEN _
  2757.          WHILE NOT EOF(2) : _
  2758.             LINE INPUT #2,BN$ : _                                    ' TC082701
  2759.             GOSUB 58112 : _
  2760.          WEND _
  2761.       ELSE FOR I = 1 TO ACTIVE.BULLETINS : _
  2762.               BN$ = MID$(STR$(I),2) : _                              ' CS082301
  2763.               GOSUB 58112 : _
  2764.            NEXT
  2765.       Q = NUM.NEW.BULLETS + 1
  2766.       IF NUM.NEW.BULLETS < 1 THEN _
  2767.          NEW.BULLETS$ = ""
  2768.       EXIT SUB
  2769. 58112 X$ = BULLETIN.PREFIX$ + _
  2770.            BN$ + _                                                   ' CS082301
  2771.            CHR$(0)
  2772.       CALL MARKTIME (X)
  2773.       CALL RBBSFIND (X$,IX,YY,MM,DD)
  2774.       IF IX = 0 THEN _
  2775.          FDATE# = DD + (100 * MM) + (10000# * (YY + 1980)) : _
  2776.          IF BASE.DATE# <= FDATE# THEN _
  2777.             NUM.NEW.BULLETS = NUM.NEW.BULLETS + 1 : _
  2778.             B$(NUM.NEW.BULLETS + 1) = BN$ : _                        ' CS082301
  2779.             NEW.BULLETS$ = NEW.BULLETS$ + _
  2780.             " " + _
  2781.             BN$                                                      ' CS082301
  2782.       RETURN
  2783.       END SUB
  2784. 58120 ' $SUBTITLE: 'SRTSTRNG - sub to sort characters in a string'
  2785. ' $PAGE
  2786. '
  2787. '  NAME    -- SRTSTRNG
  2788. '
  2789. '  INPUTS  --     PARAMETER           MEANING
  2790. '                 STRNG$           STRING TO SORT
  2791. '
  2792. '  OUTPUTS --     STRNG$           SORTED STRING
  2793. '
  2794. '  PURPOSE -- Sorts characters in passed string.
  2795. '
  2796.       SUB SRTSTRNG (STRNG$) STATIC
  2797.       S0 = LEN(STRNG$)
  2798.       S1 = S0
  2799.       X$ = "!"
  2800. 58122 S1 = S1\2
  2801.       IF S1 = 0 THEN _
  2802.          EXIT SUB
  2803.       S2 = S0 - S1
  2804.       FOR S3 = 1 TO S2
  2805.          S4 = S3
  2806. 58124    S5 = S4 + S1
  2807.          IF MID$(STRNG$,S4,1) > MID$(STRNG$,S5,1) THEN _
  2808.             LSET X$ = MID$(STRNG$,S4,1) : _
  2809.             MID$(STRNG$,S4,1) = MID$(STRNG$,S5,1) : _
  2810.             MID$(STRNG$,S5,1) = X$ : _
  2811.             S4 = S4 - S1 : _
  2812.             IF S4 > 0 THEN _
  2813.                GOTO 58124
  2814.       NEXT
  2815.       GOTO 58122
  2816.       END SUB
  2817. 58130 ' $SUBTITLE: 'INSCOMMA - sub to format commands in command prompt'
  2818. ' $PAGE
  2819. '
  2820. '  NAME    -- INSCOMMA
  2821. '
  2822. '  INPUTS  --     PARAMETER           MEANING
  2823. '                 STRNG$           STRING TO REPLACE
  2824. '
  2825. '  OUTPUTS --     STRNG$           REPLACED STRING
  2826. '
  2827. '  PURPOSE -- Inserts commands between each letter in STRNG$
  2828. '             and encloses in pointed brackets
  2829. '
  2830.       SUB INSCOMMA (STRNG$) STATIC
  2831.       L = LEN(STRNG$)
  2832.       IF L < 1 THEN _
  2833.          EXIT SUB
  2834.       LSET LINEMES$ = " <" + _
  2835.                       LEFT$(STRNG$,1)
  2836.       FOR K = 2 TO L
  2837.          MID$(LINEMES$,2 * K,2) = "," + _
  2838.                                   MID$(STRNG$,K,1)
  2839.       NEXT
  2840.       STRNG$ = LEFT$(LINEMES$,2 * L + 1) + _
  2841.                ">"
  2842.       END SUB
  2843. 58140 ' $SUBTITLE: 'LOADNEW - subroutine to get latest uploads'
  2844. ' $PAGE
  2845. '
  2846. '  NAME    -- LOADNEW
  2847. '
  2848. '  INPUTS  --     PARAMETER           MEANING
  2849. '               UPLOAD.DIRECTORY$  LIST OF FILES UPLOADED
  2850. '
  2851. '  OUTPUTS --   A$                 LATEST UPLOADS
  2852. '
  2853. '  PURPOSE -- Loads table of most recent number of uploads by date
  2854. '
  2855.       SUB LOADNEW (ARA(2)) STATIC
  2856.       IF FMS.DIRECTORY$ = "" THEN _
  2857.          EXIT SUB
  2858.       PREV.BASE$ = ""
  2859.       IF PREV.LOADNEW$ = FMS.DIRECTORY$ THEN _
  2860.          ARA(1,1) = 0 : _
  2861.          EXIT SUB
  2862.       PREV.LOADNEW$ = FMS.DIRECTORY$
  2863.       CALL OPENFMS (LAST.REC)
  2864.       FIELD 2, 23 AS PRE.DATE$, _
  2865.                 2 AS MM$, _
  2866.                 1 AS FILL1$, _
  2867.                 2 AS DD$, _
  2868.                 1 AS FILL2$, _
  2869.                 2 AS YY$, _
  2870.                 (2 + MAX.DESC.LEN) AS FILL3$, _
  2871.                 3 AS CATEGORY$, _
  2872.                 2 AS FILL4$
  2873.       MAX.RECS = UBOUND(ARA,1)
  2874.       IF MAX.RECS < 1 THEN _
  2875.          MAX.RECS = 1 _
  2876.       ELSE IF MAX.RECS > 23 THEN _
  2877.               MAX.RECS = 23
  2878.       L = 0
  2879.       K = LAST.REC
  2880.       WHILE K > 0 AND L < MAX.RECS
  2881.          GET #2,K
  2882.          IF INSTR("\= ",LEFT$(PRE.DATE$,1)) > 0 THEN _
  2883.             GOTO 58142
  2884.          IF (CAN.DOWNLOAD.FROM.UP OR CATEGORY$ <> DEFAULT.CATEGORY.CODE$) THEN _
  2885.             L = L + 1 : _
  2886.             ARA(L,1) = 372 * (VAL(YY$) - 80) + 31 * VAL(MM$) + VAL(DD$)
  2887.          IF NOT CAN.DOWNLOAD.FROM.UP THEN _
  2888.             X = MIN.SEC.TO.VIEW _
  2889.          ELSE IF CATEGORY$ = "***" THEN _
  2890.                  X = SYSOP.SECURITY.LEVEL _
  2891.               ELSE IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  2892.                       X = MIN.SEC.TO.VIEW _
  2893.                    ELSE X = OPT.SEC(19)
  2894.          ARA(L,2) = X
  2895. 58142    K = K - 1
  2896.       WEND
  2897.       CLOSE 2
  2898.       END SUB
  2899. 58150 ' $SUBTITLE: 'CTNEWFILES - sub to count how many files new'
  2900. ' $PAGE
  2901. '
  2902. '  NAME    -- CTNEWFILES
  2903. '
  2904. '  INPUTS  --     PARAMETER           MEANING
  2905. '                  LAST.ON$          Date of last logon
  2906. '                  UPLDS$            Latest uploads
  2907. '
  2908. '  OUTPUTS --    NUM.NEW.FILES       How many after last logon
  2909. '                RPT.PREFIX$         Set to "At least " if
  2910. '                                    above is a minimum
  2911. '
  2912. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  2913. '             after date of last logon that the user can download
  2914. '
  2915.       SUB CTNEWFILES (LAST.ON$,UPLDS(2),NUM.USER.FILES,RPT.PREFIX$) STATIC
  2916.       BASE.DATE = 372 * (VAL(MID$(LAST.ON$,7,2)) - 80) + _
  2917.                   31 * (VAL(MID$(LAST.ON$,1,2))) + _
  2918.                   VAL(MID$(LAST.ON$,4,2))
  2919.       NUM.NEW.FILES = 1
  2920.       NUM.USER.FILES = 0
  2921.       WHILE (BASE.DATE <= UPLDS(NUM.NEW.FILES,1) AND _
  2922.                 UPLDS(NUM.NEW.FILES,1) > 0 AND _
  2923.                 NUM.NEW.FILES < UBOUND(UPLDS,1))
  2924.          IF USER.SECURITY.LEVEL => UPLDS(NUM.NEW.FILES,2) THEN _
  2925.             NUM.USER.FILES = NUM.USER.FILES + 1
  2926.          NUM.NEW.FILES = NUM.NEW.FILES + 1
  2927.       WEND
  2928.       IF UPLDS(NUM.NEW.FILES,1) < 1 THEN _
  2929.          NUM.NEW.FILES = NUM.NEW.FILES - 1
  2930.       IF BASE.DATE <= UPLDS(NUM.NEW.FILES,1) THEN _
  2931.          RPT.PREFIX$ = "At least " _
  2932.       ELSE RPT.PREFIX$ = ""
  2933.       END SUB
  2934. 58160 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  2935. ' $PAGE
  2936. '
  2937. '  NAME    -- CTLINES
  2938. '
  2939. '  INPUTS  -- PARAMETER             MEANING
  2940. '             DIR.CATEGORY.FILE$    NAME OF THE FILE THAT HAS THE
  2941. '                                   NUMBER OF CATEGORIES IN IT.
  2942. '
  2943. '  OUTPUTS -- MAX.ENTRIES           NUMBER OF FILE CATEGORIES
  2944. '
  2945. '  PURPOSE -- Subroutine to count the number of categories that a
  2946. '             file can be classified into.
  2947. '
  2948.       SUB CTLINES (MAX.ENTRIES) STATIC
  2949.       CALL LINESNFIL (DIR.CATEGORY.FILE$,MAX.ENTRIES)
  2950.       MAX.ENTRIES = MAX.ENTRIES + 3
  2951.       IF MAX.ENTRIES < 10 THEN _
  2952.          MAX.ENTRIES = 10
  2953.       END SUB
  2954. 58161 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  2955. ' $PAGE
  2956. '
  2957. '  NAME    -- LINESNFIL
  2958. '
  2959. '  INPUTS  -- PARAMETER             MEANING
  2960. '             FILNAME$              Name of file to use
  2961. '
  2962. '  OUTPUTS -- LKNT                  Count of # of lines in file
  2963. '
  2964. '  PURPOSE -- Subroutine to count the number of categories that a
  2965. '             file can be classified into.
  2966. '
  2967.       SUB LINESNFIL (FILNAME$,LKNT) STATIC
  2968.       CALL FINDIT (FILNAME$)
  2969.       LKNT = 0
  2970.       IF OK THEN _
  2971.          WHILE NOT EOF(2) : _
  2972.             LKNT = LKNT + 1 : _
  2973.             LINE INPUT #2,A$ : _
  2974.          WEND
  2975.       CLOSE 2
  2976.       END SUB
  2977. 58162 ' $SUBTITLE: 'INITFMS - sub to initialize file management system'
  2978. ' $PAGE
  2979. '
  2980. '  NAME    -- INITFMS
  2981. '
  2982. '  INPUTS  -- PARAMETER             MEANING
  2983. '             FMS.DIRECTORY$
  2984. '
  2985. '  OUTPUTS -- CATEGORY.NAME$()  ELEMENTS 1,2, POSSIBLY MORE
  2986. '             CATEGORY.CODE$()  ELEMENTS 1,2, POSSIBLY MORE
  2987. '             CATEGORY.DESC$()  ELEMENTS 1,2, POSSIBLY MORE
  2988. '             CATEGORY.INDEX    COUNT OF # ELEMENTS IN THE FILE
  2989. '                               MANAGMENT SYSTEM
  2990. '
  2991. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  2992. '
  2993.      SUB INITFMS (CATEGORY.NAME$(1),CATEGORY.CODE$(1), _
  2994.                    CATEGORY.DESC$(1),CATEGORY.INDEX) STATIC
  2995.       BLNK$ = " "
  2996.       CATEGORY.INDEX = 0
  2997.       IF FMS.DIRECTORY$ <> "" THEN _
  2998.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  2999.          CATN$ = CATEGORY.NAME$(CATEGORY.INDEX) : _
  3000.          CALL BRKFNAME (FMS.DIRECTORY$,DRVPATH$,CATN$,EXTENSION$,FALSE) : _
  3001.          CATEGORY.NAME$(CATEGORY.INDEX) = CATN$ : _
  3002.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3003.          CATEGORY.DESC$(CATEGORY.INDEX) = "All uploads"_
  3004.       ELSE LIMIT.SEARCH.TO.FMS = FALSE : _
  3005.            EXIT SUB
  3006.       IF LIMIT.SEARCH.TO.FMS OR MASTER.DIRECTORY.NAME$ = MAIN.FMS.DIRECTORY$ THEN _
  3007.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3008.          CATEGORY.NAME$(CATEGORY.INDEX) = "ALL" : _
  3009.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3010.          CATEGORY.DESC$(CATEGORY.INDEX) = "All files"
  3011.       CALL FINDIT (DIR.CATEGORY.FILE$)
  3012.       IF NOT OK THEN _
  3013.          EXIT SUB
  3014.       WHILE NOT EOF(2)
  3015.          CALL READPARMS (WORK.ARA$(),3,1)
  3016.          IF EC > 0 THEN _
  3017.             EC = 0 : _
  3018.             CALL PSCRN (DIR.CATEGORY.FILE$+" invalid.  Line" + STR$(CATEGORY.INDEX) + " needs 3 parms") : _
  3019.             CALL DELAYIT (4) _
  3020.          ELSE CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3021.               CATEGORY.NAME$(CATEGORY.INDEX) = WORK.ARA$(1) : _
  3022.               CATEGORY.CODE$(CATEGORY.INDEX) = WORK.ARA$(2) : _
  3023.               CATEGORY.DESC$(CATEGORY.INDEX) = WORK.ARA$(3) : _
  3024.               CATR$ = CATEGORY.CODE$(CATEGORY.INDEX) : _
  3025.               CALL REMOVE (CATR$,BLNK$) : _
  3026.               CATEGORY.CODE$(CATEGORY.INDEX) = CATR$
  3027.       WEND
  3028.       CLOSE 2
  3029.       END SUB
  3030. 58165 ' $SUBTITLE: 'DISUPDIR - sub to display upload direcotry'
  3031. ' $PAGE
  3032. '
  3033. '  NAME    -- DISUPDIR
  3034. '
  3035. '  INPUTS  -- PARAMETER             MEANING
  3036. '             PASSED.CATEGORIES$    FILE "CATEGORIES" TO BE INCLUDED IN
  3037. '                                   THE SEARCH.
  3038. '             SEARCH.STRING$        STRING TO SEARCH ON WITHIN THE
  3039. '                                   FILE "CATEGORIES" SELECTED
  3040. '             SEARCH.DATE$          DATE EQUAL TO OR GREATER THAN TO BE
  3041. '                                   SEARCHED FOR WITH THE "CATEGORIES"
  3042. '                                   AND THE STRING TO SEARCH.
  3043. '             DOWNLOAD.FLAG         SET TO RECORD # OF LINE TO BEGIN
  3044. '                                   VIEWING - 0 IF AT END
  3045. '
  3046. '  OUTPUTS -- DOWNLOAD.FLAG         WHENEVER DOWNLOAD REQUESTED, SETS
  3047. '                                   TO NEXT RECORD TO VIEW.  OTHERWISE
  3048. '                                   LEAVES AT ZERO
  3049. '  PURPOSE -- Display the files that meet the criteria selected in
  3050. '             RBBS-PC upload management system on the users screen.
  3051. '
  3052.       SUB DISUPDIR (PASSED.CATEGORIES$,SEARCH.STRING$, _
  3053.                     SEARCH.DATE$,DOWNLOAD.FLAG,ABORT.INDEX) STATIC
  3054.       CALL ALLCAPS (SEARCH.STRING$)
  3055.       BLNK$ = " "
  3056.       STOP.INTERRUPTS = FALSE
  3057.       LAST.INDEX = 0                                                 ' KG081201
  3058.       CATEGORIES$ = "," + _
  3059.                     PASSED.CATEGORIES$ + _
  3060.                     ","
  3061.       CAN.DOWNLOAD = (USER.SECURITY.LEVEL => OPT.SEC(19))
  3062.       GOSUB 58185
  3063.       IF DOWNLOAD.FLAG > 0 THEN _
  3064.          UPLOAD.INDEX = DOWNLOAD.FLAG : _
  3065.          DOWNLOAD.FLAG = 0 : _
  3066.          GOTO 58180
  3067.       EXTRA.PRMPT$ = ",V)iew"
  3068.       IF CAN.DOWNLOAD THEN _
  3069.          IF TURBO.KEY.USER THEN _
  3070.             EXTRA.PRMPT$ = EXTRA.PRMPT$ + ",D)ownload" _
  3071.          ELSE EXTRA.PRMPT$ = EXTRA.PRMPT$ + ", or file(s) to download"
  3072.       MAX.PRINT = PAGE.LENGTH - 1
  3073.       BELOW.MIN.SEC = (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW)
  3074.       NON.STOP = NON.STOP OR (PAGE.LENGTH < 1)
  3075.       CHECK.POINT = 0
  3076.       WILD.SEARCH = (INSTR(SEARCH.STRING$,"?") > 0) _
  3077.                      OR (INSTR(SEARCH.STRING$,"*") > 0)
  3078. 58168 UPLOAD.INDEX = UPLOAD.INDEX + UPINC
  3079.       IF UPLOAD.INDEX = CUTOFF.REC THEN _
  3080.          GOTO 58182
  3081.       GET #2,UPLOAD.INDEX
  3082.       CHECK.POINT = CHECK.POINT + 1
  3083.       ON INSTR("\* =",LEFT$(PART.TO.PRINT$,1)) GOTO 58168,58171,58170,58169
  3084.       GOTO 58172
  3085. 58169 A = VAL(MID$(PART.TO.PRINT$,34))
  3086.       IF USER.SECURITY.LEVEL < A THEN _
  3087.          LAST.OK = FALSE : _
  3088.          GOTO 58168
  3089.       MID$(PART.TO.PRINT$,1,13) = MID$(PART.TO.PRINT$,2,12) + " "
  3090.       A = LEN(STR$(A))
  3091.       MID$(PART.TO.PRINT$,34) = MID$(PART.TO.PRINT$,34 + A) + SPACE$(A)
  3092.       GOTO 58172
  3093. 58170 IF EXTENDED.OFF THEN _
  3094.          GOTO 58168 _
  3095.       ELSE IF LAST.OK THEN _
  3096.          GOTO 58175 _
  3097.       ELSE IF SEARCH.STRING$ <> "" AND (NOT WILD.SEARCH) AND FAILED.SEARCH THEN _
  3098.               A$ = PART.TO.PRINT$ : _
  3099.               CALL ALLCAPS (A$) : _
  3100.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3101.               IF HIGHLITE.POS > 0 THEN _
  3102.                  HIGHLITE.REC = UPLOAD.INDEX : _
  3103.                  UPLOAD.INDEX = LAST.FNAME : _
  3104.                  GET 2,UPLOAD.INDEX :_
  3105.                  GOTO 58175 _
  3106.               ELSE GOTO 58168 _
  3107.            ELSE GOTO 58168
  3108. 58171 IF CATEGORY$ = "***" THEN _
  3109.          GOTO 58176 _
  3110.       ELSE KEE$ = "," + CATEGORY$ + "," : _
  3111.            IF INSTR(CATEGORIES$,KEE$) > 0 THEN _
  3112.               GOTO 58176 _
  3113.            ELSE GOTO 58168
  3114. 58172 LAST.OK = FALSE
  3115.       FAILED.SEARCH = FALSE
  3116.       LAST.FNAME = UPLOAD.INDEX
  3117.       IF CATEGORY$ = "***" THEN _
  3118.          IF NOT SYSOP THEN _
  3119.             GOTO 58178
  3120.       IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3121.          IF BELOW.MIN.SEC THEN _
  3122.             GOTO 58178
  3123. 58173 IF LEN(CATEGORIES$) > 2 THEN _
  3124.          KEE$ = "," + _
  3125.                 CATEGORY$ + _
  3126.                 "," : _
  3127.          CALL REMOVE (KEE$,BLNK$) : _
  3128.          IF INSTR(CATEGORIES$,KEE$) = 0 THEN _
  3129.             GOTO 58178
  3130.       IF SEARCH.STRING$ <> "" THEN _
  3131.          A$ = PART.TO.PRINT$ : _
  3132.          IF WILD.SEARCH THEN _
  3133.             CALL WILDFILE (SEARCH.STRING$,LEFT$(PART.TO.PRINT$,INSTR(PART.TO.PRINT$," ")-1),OK) : _
  3134.             IF OK THEN _
  3135.                GOTO 58175 _
  3136.             ELSE GOTO 58178 _
  3137.          ELSE CALL ALLCAPS (A$) : _
  3138.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3139.               IF HIGHLITE.POS > 0 THEN _
  3140.                  HIGHLITE.REC = UPLOAD.INDEX _
  3141.               ELSE FAILED.SEARCH = TRUE : _
  3142.                    GOTO 58178
  3143. 58174 IF SEARCH.DATE$ <> "" THEN _
  3144.          KEE$ = MID$(PART.TO.PRINT$,30,2) + _
  3145.                 MID$(PART.TO.PRINT$,24,2) + _
  3146.                 MID$(PART.TO.PRINT$,27,2) : _
  3147.          IF KEE$ < SEARCH.DATE$ THEN _
  3148.             IF DATE.ORDERED.FMS THEN _
  3149.                GOTO 58183 _
  3150.             ELSE GOTO 58168
  3151. '
  3152. '
  3153. ' * Allow the FMS to be both fast and interruptable if a local
  3154. ' * user or there is nothing in the input buffer by using QTPUT.
  3155. '
  3156. '
  3157. 58175 LAST.OK = TRUE
  3158. 58176 A = END.DESC
  3159.       IF LEFT$(PART.TO.PRINT$,5) = "     " THEN _
  3160.          GOTO 58178
  3161.       A$ = PART.TO.PRINT$                                            ' KG081202
  3162.       CALL TRIMTRAIL (A$," ")                                        ' KG081202
  3163.       CALL COLORDIR (A$,"Y")
  3164.       IF UPLOAD.INDEX = HIGHLITE.REC THEN _
  3165.          HIGHLITE.REC = -1 : _
  3166.          HIGHLITE.POS = 0 : _
  3167.          CALL CHKCOLOR (A$,SEARCH.STRING$,"")
  3168. 58177 IF LOCAL.USER THEN _
  3169.          CALL QTPUT1 (A$) : _
  3170.          GOTO 58178
  3171.       CALL EOFCOMM (CHAR%)
  3172.       IF CHAR% = -1 THEN _
  3173.          CALL QTPUT1 (A$) _
  3174.       ELSE SUBROUTINE.PARAMETER = 5 : _
  3175.            CALL TPUT : _
  3176.            IF RET THEN _
  3177.               GOTO 58183
  3178. 58178 IF LINES.PRINTED <= MAX.PRINT AND CHECK.POINT < 1000 THEN _
  3179.          GOTO 58168
  3180.       CALL CHKCARRIER                                                ' KG061203
  3181.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3182.          GOTO 58183
  3183.       CALL TIMEREMAIN (TIME.REMAINING!)
  3184.       IF TIME.REMAINING! < 0.1 THEN _
  3185.          SUBROUTINE.PARAMETER = -1 : _
  3186.          GOTO 58183
  3187.       IF NON.STOP THEN _
  3188.          GOTO 58168
  3189.       IF LINES.PRINTED <= MAX.PRINT THEN _
  3190.          CALL QTPUT1 (EMPHASIZE.OFF$ + "Files checked thru " + MID$(PART.TO.PRINT$,24,8))
  3191. 58180 TURBO.KEY = -TURBO.KEY.USER
  3192.       CALL ASKMORE (EXTRA.PRMPT$, TRUE, FALSE,ABORT.INDEX,FALSE)
  3193.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3194.          GOTO 58183
  3195.       IF NO THEN _
  3196.          GOTO 58183                                                  ' KG082702
  3197.       CALL ALLCAPS (B$(1))
  3198.       IF B$(1) = "V" THEN _
  3199.          LAST.INDEX = Q : _                                          ' KG082702
  3200.          ANS.INDEX = 1 : _                                           ' KG082702
  3201.          CALL GETARC : _
  3202.          A = UPLOAD.INDEX : _
  3203.          GOSUB 58185 : _
  3204.          UPLOAD.INDEX = A : _
  3205.          GOTO 58180
  3206.       IF B$(1) = "D" THEN _
  3207.          A$ = "Download what file(s)" : _
  3208.          CALL POPCSTACK : _                                          ' KG081201
  3209.          IF Q = 0 THEN _
  3210.             GOTO 58180
  3211.       IF LEN(B$(1)) > 2 THEN _
  3212.          IF NOT YES AND CAN.DOWNLOAD THEN _
  3213.             CALL SKIPLINE (1) : _
  3214.             DOWNLOAD.FLAG = UPLOAD.INDEX : _
  3215.             LAST.INDEX = Q : _                                       ' KG081201
  3216.             ANS.INDEX = 1 : _                                        ' KG081201
  3217.             EXIT SUB
  3218.       IF NON.STOP THEN IF UPLOAD.INDEX > 999 THEN _
  3219.          IF (SEARCH.DATE$ = "" OR NOT EXPERT.USER) THEN _
  3220.             A$ = STR$(UPLOAD.INDEX) + _
  3221.                " lines left to search.  Really go non-stop? (Y/[N])" : _
  3222.             NO.ADVANCE = TRUE : _
  3223.             TURBO.KEY = -TURBO.KEY.USER : _
  3224.             SUBROUTINE.PARAMETER = 1 : _
  3225.             CALL TGET : _
  3226.             CALL WIPELINE (79) : _
  3227.             NON.STOP = YES                                           ' KG072301
  3228.       CHECK.POINT = 0
  3229.       GOTO 58168
  3230. 58182 IF CHAINED.DIR$ <> "" THEN _
  3231.          ACTIVE.FMS.DIRECTORY$ = CHAINED.DIR$ : _
  3232.          GOSUB 58185 : _
  3233.          GOTO 58168
  3234. 58183 CLOSE 2
  3235.       NON.STOP = (PAGE.LENGTH < 1)
  3236.       STOP.INTERRUPTS = FALSE
  3237.       A$ = ""
  3238.       EXIT SUB
  3239. 58185 CALL OPENFMS (UPLOAD.INDEX)
  3240.       END.DESC = 33 + MAX.DESC.LEN
  3241.       FIELD 2, END.DESC AS PART.TO.PRINT$, _
  3242.                3 AS CATEGORY$, _
  3243.                2 AS FILLER$
  3244.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  3245.       IF UPINC = -1 THEN _
  3246.          CUTOFF.REC = 0 : _
  3247.          UPLOAD.INDEX = UPLOAD.INDEX + 1 _
  3248.       ELSE CUTOFF.REC = UPLOAD.INDEX + 1 : _
  3249.            UPLOAD.INDEX = 0
  3250.       RETURN
  3251.       END SUB
  3252. '
  3253. '
  3254. ' $SUBTITLE: 'CONVERT2ZIP - subroutine to Convert to ZIP format'
  3255. ' $PAGE
  3256. '
  3257. '  NAME    -- CONVERT2ZIP
  3258. '
  3259. '  Parameters             DR$  drive/subdir were file is located
  3260. '                         ZZ$  Filename (no Extension)
  3261. '                          X$  extension of file being converted
  3262. '
  3263. '  PURPOSE -- Convert files to Zip format if remote user
  3264. '
  3265.       SUB CONVERT2ZIP (DR$,ZZ$,X$) STATIC
  3266.  IF X$ = ".ZIP" THEN _
  3267.  CALL QTPUT (FILE.NAME.HOLD$ +" Now being verified and re-Zipped Please wait!",1) : _
  3268.   Z$ = "PKUNZIP -x " + FILE.NAME$ + " " _
  3269.        ELSE _
  3270.         CALL QTPUT (FILE.NAME.HOLD$ +" Now being converted to .ZIP format. Please wait!",1) : _
  3271.           IF X$ = ".ARC" OR X$ = ".PAK" THEN _
  3272.              Z$ = "PAK e " + FILE.NAME$ + " " : _
  3273.           ELSE IF X$ = ".LZH" THEN _
  3274.              Z$ = "LHARC e " + FILE.NAME$ + " " : _
  3275.           ELSE IF X$ = ".ZOO" THEN _
  3276.              Z$ = "ZOO.BAT " + FILE.NAME$ + " " : _
  3277.           ELSE _
  3278.              Z$ = "COPY " +FILE.NAME$ + " "
  3279. '
  3280.           B$ = "CONVERT"+NODE.ID$+".BAT"
  3281.           CALL OPENOUTW (B$) : _
  3282.           PRINT #2, "MD " + LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$
  3283.           PRINT #2, "ECHO OFF"
  3284.           PRINT #2, "CTTY GATE"+RIGHT$(COM.PORT$,1)
  3285.           PRINT #2, "SETERROR 0"
  3286.    IF X$ = ".LZH" THEN _
  3287.       PRINT #2, Z$ + LIBRARY.WORK.DISK.PATH$ +"WORK"+ NODE.ID$ +"\" _
  3288.      ELSE _
  3289.           PRINT #2,  Z$ + LIBRARY.WORK.DISK.PATH$ +"WORK"+ NODE.ID$
  3290.           PRINT #2,  "DEL " + FILE.NAME$
  3291.           PRINT #2, "IF ERRORLEVEL 1 GOTO ERR "
  3292.           PRINT #2, "PKZIP -m -ex " + DR$ + ZZ$ + " " + _ 
  3293.                  LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$ + "\*.*"
  3294.           PRINT #2,":ERR"
  3295.           PRINT #2, "CTTY CON"
  3296.           PRINT #2,  "KDY " + LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$
  3297.           PRINT #2,"SETERROR 0"
  3298.           PRINT #2, "ECHO ON"
  3299.           PRINT #2, "EXIT"
  3300.       CALL DELAYIT (8 + BPS)
  3301.       IF FOSSIL THEN _
  3302.          CALL FOSEXIT(COMPORT%) _
  3303.       ELSE CLOSE 3 : _
  3304.            OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  3305.       CLOSE 2
  3306.        SHELL "COMMAND.COM /C "+B$
  3307.       IF FOSSIL THEN _
  3308.          CALL FOSINIT(COMPORT%,RESULT%) : _
  3309.          IF RESULT% = -1 THEN _
  3310.             CALL PSCRN("ERROR INITIALIZING FOSSIL AFTER EXTERNAL PROTOCOL") : _
  3311.             SYSTEM
  3312.       CALL DELAYIT (2)
  3313.       CALL RESTORECOM
  3314.        FILE.NAME.HOLD$ = ZZ$ + ".ZIP"
  3315.        FILE.NAME$ = DR$ + FILE.NAME.HOLD$
  3316. '
  3317. ' ***  adds BBS name , users name and description to Zip comment if succesfull
  3318.  CALL FINDIT (FILE.NAME$)
  3319.   IF OK THEN
  3320.     CLOSE 2
  3321.      COMMENT.NAME$ = UPLOAD.SUBDIR$ +"\UPLOAD.CMT
  3322.       ADDCMT1$ =CRLF$ +"Uploaded to "+ RBBS.NAME$ +" By: "+ACTIVE.USER.NAME$
  3323.        ADDCMT2$ = CRLF$ +"Description: " + DESC$
  3324.        ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + CRLF$
  3325.       CALL OPENOUTW (COMMENT.NAME$)
  3326.      PRINT #2, ADDCOMMENT$
  3327.     CLOSE 2
  3328.    ADDCMT$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -z<"+COMMENT.NAME$+" "+ FILE.NAME$
  3329.   SHELL ADDCMT$ 
  3330.  END IF
  3331. END SUB
  3332. '
  3333. '
  3334. ' $SUBTITLE: 'LOCALCONVERT - subroutine to Convert to ZIP format'
  3335. ' $PAGE
  3336. '
  3337. '  NAME    -- LOCALCONVERT
  3338. '
  3339. '  Parameters             DR$  drive/subdir were file is located
  3340. '                         ZZ$  Filename (no Extension)
  3341. '                          X$  extension of file being converted
  3342. '
  3343. '  PURPOSE -- Convert files to Zip format if LOCAL  user
  3344. '
  3345.       SUB LOCALCONVERT (DR$,ZZ$,X$) STATIC
  3346. '
  3347.  IF X$ = ".ZIP" THEN _
  3348.    CALL QTPUT (FILE.NAME.HOLD$ +" Now being verified and re-Zipped Please wait!",1) : _
  3349.      Z$ = "PKUNZIP -x " + FILE.NAME$ + " " _
  3350.     ELSE _
  3351.    CALL QTPUT (FILE.NAME.HOLD$ +" Now being converted to .ZIP format. Please wait!",1) : _
  3352.     IF X$ = ".ARC" OR X$ = ".PAK" THEN _
  3353.      Z$ = "PAK e " + FILE.NAME$ + " " : _
  3354.       ELSE IF X$ = ".LZH" THEN _
  3355.        Z$ = "LHARC e " + FILE.NAME$ + " " : _
  3356.         ELSE IF X$ = ".ZOO" THEN _
  3357.        Z$ = "ZOO.BAT " + FILE.NAME$ + " " : _
  3358.       ELSE _
  3359.      Z$ = "COPY " +FILE.NAME$ + " "
  3360. '
  3361.   B$ = "CONVERT"+NODE.ID$+".BAT"
  3362.    CALL OPENOUTW (B$) : _
  3363.     PRINT #2, "MD " + LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$
  3364.      IF X$ = ".LZH" THEN _
  3365.       PRINT #2, Z$ + LIBRARY.WORK.DISK.PATH$ +"WORK"+ NODE.ID$ +"\" _
  3366.       ELSE _
  3367.        PRINT #2,  Z$ + LIBRARY.WORK.DISK.PATH$ +"WORK"+ NODE.ID$
  3368.        PRINT #2,  "DEL " + FILE.NAME$
  3369.        PRINT #2, "IF ERRORLEVEL 1 GOTO ERR "
  3370.        PRINT #2, "PKZIP -m -ex " + DR$ + ZZ$ + " " + _ 
  3371.                   LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$ + "\*.*"
  3372.        PRINT #2,":ERR"
  3373.        PRINT #2,  "KDY " + LIBRARY.WORK.DISK.PATH$ + "WORK"+NODE.ID$
  3374.        PRINT #2,"SETERROR 0"
  3375.        PRINT #2, "EXIT"
  3376.     CLOSE 2
  3377.   SHELL "COMMAND.COM /C "+B$
  3378.   FILE.NAME.HOLD$ = ZZ$ + ".ZIP"
  3379.   FILE.NAME$ = DR$ + FILE.NAME.HOLD$
  3380.   CALL FINDIT (FILE.NAME$)
  3381.    IF OK THEN
  3382.     CLOSE 2
  3383.      COMMENT.NAME$ = UPLOAD.SUBDIR$ +"\UPLOAD.CMT
  3384.        ADDCMT1$ =CRLF$ +"Uploaded to "+ RBBS.NAME$ +" By: "+ACTIVE.USER.NAME$
  3385.         ADDCMT2$ = CRLF$ +"Description: " + DESC$
  3386.        ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + CRLF$
  3387.       CALL OPENOUTW (COMMENT.NAME$)
  3388.      PRINT #2, ADDCOMMENT$
  3389.     CLOSE 2
  3390.    ADDCMT$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -z<"+COMMENT.NAME$+" "+ FILE.NAME$
  3391.   SHELL ADDCMT$ 
  3392.  END IF
  3393. END SUB
  3394.